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/************  16QDEM.C  (16QAM  Demodulator)  ************/ 

/*  Function  qaml6_dem()  */ 

# include  <stdio.h> 

# include  ''type.h” 

# include  "star.h" 

typedef  struct  { 
int  non; 

}  PARAM,  *PARAMPTR; 

typedef  struct  { 

FILE  *fp; 
int  time; 

}  STATE,  *STATEPTR; 

qaml 6_dem  ( pparam , s i z e , pstate , pstar ) 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 
int  size; 

{ 

SAMPLE  linput, Q input, output ; 
int  i, point; 
float  test, min; 

FILE  *fopen(); 

if  (pstate  ==  NULL)  { 

pstate  ®  (STATEPTR)  alloc_state_var(l, sizeof (STATE) ) ; 
if  (no_input_f ifos (  )  !=1  | |  no_output_f ifos (  )  !=l)  return (3) ; 
pstate->time=0 ; 

pstate->f p=f open ( "graf . dat" , "w" ) ; 

) 

if  (Iength_output_fifo(0)==maxlength_output_fifo(0) )  return(O) ; 

while (length_input_f if 0(0)  >  1) 

{ 

if (Iength_output_fifo(0)==maxlength_output_fifo(0) )  return(O) ; 
get (0, Slinput) ; 
get (0, SQinput) ; 

if (pstate->time<2000)  fprintf (pstate->fp, "\n%f ,  %f\r” , linput, Qinput) ; 
if (pstate->time==2000)  fclose (pstate->fp) ; 

min=10000 ; 
for (i=0;i<4 ;i++) 

{ 

test=  (linput- (i*2-3) ) *( linput- (i*2-3) ) ; 
if(test<min)  {min=test;  point=i;} 

} 

output= (SAMPLE) (point&Ol) ; 
put (0, output) ; 

output=( SAMPLE) ( (point>>l) &01) ; 
put (0, output) ; 
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inin=10000 ; 
for(i=0;i<4;i++) 

{ 

test=  (Qinput-(i*2-3) ) * (Qinput- (i*2-3) ) ; 
if  (test<inin)  {min=test;  point=i;) 

} 

output= (SAMPLE) (point&Ol) ; 
put (0, output) ; 

output=( SAMPLE)  ( (point»l)  &01)  ; 
put (0, output) ; 

pstate->tiine++  ; 

} 

return  ( 0 )  ; 

) 
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/*************  16QM0D.C  (16QAM  Modulator)  *************/ 

/*  Function  qainl6_mod()  */ 

# include  <stdio.h> 

# include  "type.h” 

#include  "star.h” 

#define  SCALE  1 

typedef  struct  { 
int  non; 

)  PARAM,  *PARAMPTR; 

typedef  struct  { 
int  none; 

)  STATE,  *STATEPTR; 

qainl6_inod  (pparam, size, pstate, pstar) 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 
int  size; 

{ 

SAMPLE  input , loutput , Qoutput ; 
int  point; 

if  (pstate  ==  NULL)  { 

pstate  =  (STATEPTR)  alloc_state_var(l,sizeof (STATE) ) ; 
if  (no_input_fifos (  )  !=1  ||  no_output__fifos (  )  !=1)  return (3)  ; 
} 

if  (Iength_output_fifo(0)==maxlength_output_fifo(0) )  return(O) ; 

while (length_input_fifo(0)  >  3) 

{ 

if (Iength_output_fifo(0)==maxlength_output_fifo(0) )  return(O) ; 

point=0; 

get (0,  fitinput) ; 

point  *=  (input>0) ; 

get (0, Siinput)  ; 

point  '=  (input>0)*2; 

Ioutput=SCALE* (2*point-3) ; 

put(0, loutput) ; 

point=0 ; 

get(0, &input) ; 

point  *=  (input>0) ; 

get (0, &input) ; 

point  *=  (input>0)*2; 

Qoutput=SCALE* (2*point-3 ) ; 
put (0, Qoutput) ; 

} 

return  ( 0 )  ; 

) 
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/************  64QDEM.C  (64QAM  Demodulator)  *************/ 

/*  Function  qam64_dem()  */ 

# include  <stdio.h> 

# include  "type.h” 

# include  "star.h” 

typedef  struct  { 
int  non; 

}  PARAM,  *PARAMPTR; 

typedef  struct  { 

FILE  *fp; 
int  time; 

)  STATE,  *STATEPTR; 

qam64_dem  (pparam, size , pstate, pstar) 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 
int  size; 

{ 

SAMPLE  linput ,Q input, output ; 
int  i, point; 
float  test, min; 

FILE  *fopen() ; 

if  (pstate  ==  NULL)  { 

pstate  =  (STATEPTR)  alloc_state_var ( 1 , sizeof (STATE) ) ; 
if  (no_input_fifos (  )  !=1  ||  no_output_f ifos (  )  !=1)  return (3 ) ; 
pstate“>time=0 ; 

pstate->f p=f open ( "graf . dat” , "w" ) ; 

} 

if  (Iength_output_fifo(0)==maxlength_output_fifo(0) )  return(O) ; 

while (length_input_fifo(0)  >  1) 

{ 

if (Iength_output_fifo(0)==maxlength_output_fifo(0) )  return(O) ; 
get(0,&linput) ; 
get (0, &Q input) ; 

if  (pstate->time<2000)  fprintf  (pstate->fp,  ”\n%f ,  %f\r'' ,  linput ,  Qinput)  ; 
if (pstate->time==2000)  fclose (pstate->fp) ; 

min=10000 ; 
for(i=0;i<8;i++) 

{ 

test=  (Iinput-(i*2-7) ) * (Iinput-(i*2-7) ) ; 
if(test<min)  {min=test;  point=i;} 

) 

for(i=0;i<3 ;i++)  { output= ( SAMPLE ) ( (point>>i) &01) ;  put (0 , output) ;} 

min=10000 ; 

for ( i=0 ; i<8 ; i++) 
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{ 

test=  (Qinput-(i*2“7) ) * (Qinput- (i*2-7) ) ; 
if(test<min)  {inin=test;  point=i;) 

} 

for(i=0;i<3 ;i++)  {output=( SAMPLE) ( (point»i) &01) ;  put ( 0 , output ) ;} 

pstate->time++ ; 

} 

return  ( 0 )  ; 

) 
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/**************  64QMOD.C  (64QAM  Modulator)  *************/ 

/*  Function  qain64_inod  ( )  */ 

# include  <stdio.h> 

# include  "type.h” 

# include  "star.h” 

#define  SCALE  1 

typedef  struct  { 
int  non; 

}  PARAM,  *PARAMPTR; 

typedef  struct  { 
int  none; 

}  STATE,  *STATEPTR; 

qam64_inod  (pparam, size, pstate, pstar) 

PARAMPTR  pparam; 

STATEPfR  pstate; 

STARPTR  pstar; 
int  size; 

{ 

SAMPLE  input , I output , Qoutput ; 
int  point; 

if  (pstate  ==  NULL)  { 

pstate  =  (STATEFTR)  alloc_state_var ( 1 , sizeof (STATE) ) ; 
if  (no_input_fifos(  )  !=1  |(  no_output_fifos (  )  !=1)  return (3 ) ; 
} 

if  (Iength_output_fifo(0)==maxlength_output_fifo(0) )  return(O) ; 

while(length_input_fifo(0)  >  5) 

{ 

if (Iength_output_fifo(0)==maxlength_output_fifo(0) )  return (0) ; 

point=0 ; 

get (0, & input) ; 

point  “=  (input>0) ; 

get (0, & input) ; 

point  *=  (input>0)*2; 

get (0, & input) ; 

point  *=  (input>0)*4; 

Ioutput=SCALE* (2*point-7) ; 

put (0, I output) ; 

point=0 ; 

get ( 0, & input) ; 

point  "=  (input>0) ; 

get (0, & input) ; 

point  “=  (input>0)*2; 

get (0, Sinput) ; 

point  *=  (input>0)*4; 

Qoutput=SCALE* (2*point-7) ; 
put (0, Qoutput) ; 

} 

return  ( 0 )  ; 

) 
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/*************  8PDEM.C  (  8PSK  Demodulator)  *************/ 

/*  Function  psk8_dem()  */ 

# include  <stdio.h> 

# include  <mth.h> 

# include  "type.h” 

# include  "star.h" 

#define  THETA  0.785398  /*  2*PI/8  */ 

typedef  struct  { 
int  non; 

)  PARAM,  *PARAMPTR; 

typedef  struct  { 

float  x[8] ,y[8] ; 

FILE  *fp; 
int  time; 

)  STATE,  *STATEPTR; 

psk8_dem  (pparam, size,pstate,pstar) 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 
int  size; 

{ 

SAMPLE  Iinput,Qinput, output ; 
int  i, point; 
float  test, min; 

FILE  *fopen(); 

if  (pstate  ==  NULL)  ( 

pstate  =  (STATEPTR)  alloc_state_var ( 1 , sizeof (STATE) ) ; 
if  (no_input_f ifos (  )  !=1  | |  no_output_f ifos (  )  !=1)  return (3) ; 
for ( i=0 ; i<8 ; i++) 

fpstate->x[i]=cos(i*THETA) ;  pstate->y[i]=sin(i*THETA) ; } 
pstate->fp=fopen(''graf  .dat",  "w”)  ; 
pstate->time=0 ; 

) 

if  (Iength_output_fifo(0)==maxlength_output_fifo(0) )  return(O) ; 

while (length_input_f if o(0)  >  1) 

{ 

if ( length_output_f if o (0) ==maxlength_output_f ifo (0) )  return ( 0) ; 

get (0, &I input) ; 
get (0, &Qinput) ; 

if  (pstate->time<2000)  fprintf  (pstate->fp,  ”\n%f ,  %f\r'',  Iinput,Qinput)  ; 
if (pstate->time— 2000)  f close (pstate->fp) ; 

min=  -Iinput*pstate->x [ 0 ] -Qinput*pstate->y [ 0 ] ; 
point=0; 

for(i=l;i<8;i++) 

{ 

test=  -Iinput*pstate->x[ i] -Qinput*pstate->y [i] ; 
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if (test<inin)  {inin=test;  point=i;} 
} 

output=2* (point&Ol) -1; 

put (0, output) ; 

output=2*  ( (point»l)  &01)  -1  ; 

put (0, output) ; 

output=2* ( (point>>2) &01) -1; 

/*. 

printf (''\ndem:  %4d  ", point); 

printf("  %f  %f " , linput , Qinput) ; 

*/ 

put (0, output) ; 
pstate->tiine++ ; 

} 

return  ( 0 )  ; 

} 


/*************  8PM0D.C  (8PSK  Modulator)  *************/ 

/*  Function  psk8_mod()  */ 

# include  <rstdio.h> 

# include  <inth.h> 

# include  "type.h” 

#include  "star.h” 

#define  THETA  0.78539816  /*  2*PI/8  */ 

typedef  struct  { 
int  non; 

}  PARAM,  *PARAMPTR; 

typedef  struct  { 
int  none; 

)  STATE,  *STATEPTR; 

psk8_mod  (pparam, size,pstate,pstar) 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 
int  size; 

{ 

SAMPLE  i nput , I output , Qoutput ; 
int  point  ? 

if  (pstate  ==  NULL)  { 

pstate  =  (STATEPTR)  alloc_state_var (1, sizeof (STATE) ) ; 
if  (no_input_fifos (  )  !=1  ||  no_output_fifos (  )  !=1)  return(3) ; 
} 

if  (Iength_output_fifo(0)==maxlength_output_fifo(0) )  return(O) ; 

while (length_input_fifo(0)  >  2) 

{ 

if (Iength_output_fifo(0)==maxlength_output_fifo(0) )  return(O) ; 

point=0 ; 

get (0, & input) ; 

point  *=  (input>0) ; 

get (0, & input) ; 

point  *=  (input>0)*2; 

get (0, & input) ; 

point  *=  (input>0)*4; 

Ioutput=cos (THETA*point) ; 

Qoutput=sin(THETA*point) ; 

/* 

printf  ( '*8psk_mod;  %4d'', point)  ; 
printf(''  %f  %f  ”,  I  output ,  Qoutput )  ; 

*/ 

put (0, I out put) ; 
put (0, Qoutput) ; 

} 

return  ( 0 )  ; 

} 
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/*******************  ADD.C  *********************/ 

/*  Function  adder ()  */ 

#  include  "type.h” 

#  include  "star.h” 

#  include  <stdio.h> 

typedef  struct  { 
int  non; 

}  PARAM,*PARAMPTR; 
typedef  struct  { 
int  none; 

}  STATE,*STATEPTR; 

adder (pparam, size, pstate , pstar) 
inc  size; 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 

{ 

SAMPLE  signal , noise, output ; 
int  none; 

if  (pstate  ==  NULL  )  { 

pstate= (STATEPTR)  ailoc_state_var(l, si zeof (STATE) ) ; 
if (no_input_f ifos ( )  !=  2  )  return (1) ; 
if (no_output_fifos()  !=  1)  return (2 ) ; 

} 

if (length_output_fifo(0)  ==  maxlength_output_fifo(0) ) 
if (length_input_fifo(0)  <2) 
if (length_input_fifo(0) %2  1=  0) 
if (length_input_f ifo(l)  <2) 
if (length_input_fifo(l) %2  !=  0) 

if (length_input_fifo(0)  i=  length_input_f ifo (1) ) 

while (length_input_fifo(l)  >1) 

{ 

if (length_output_fifo(0)  ==  maxlength_output_fifo(0) ) 
get (0,  fitsignal) ; 
get (1, &noise) ; 
output=signai+noise ; 
put (0, output) ; 

get ( 0 , &signal ) ; 
get (1, &noise) ; 
output=signai+noise ; 
put (0, output) ; 


return (0) ; 
return (0)  ; 
return (56)  ; 
return (0) ; 
return (57)  ; 
return (59) ; 


) 

return (0) ; 

) 


return (0) 


10 


/*******************  BFDEM.C  ********************/ 

/*  Function  bfsk_dein()  */ 

# include  <stdio.h> 

# include  "type.h" 

# include  "star.h" 

typedef  struct  { 
int  non; 

}  PARAM,  *PARAMPTR; 

typedef  struct  { 
int  time; 

FILE  *fp; 

)  STATE,  *STATEPTR; 

bfsk_dem  (pparam, size,pstate,pstar) 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 
int  size; 

{ 

SAMPLE  I inp_wl , I inp_w2 , Qinp_w2 , Qinp_wl , output ; 
float  ql,q2; 

FILE  *fopen(); 

if  (pstate  ==  NULL)  { 

pstate  =  (STATEPTR)  alloc_state_var ( 1 , sizeof (STATE) ) ; 
if  (no_input_fifos(  )  !=1  ||  no_output_fifos (  )  !=1) 
pstate->f p=f open ( "graf . dat” , ”w" ) ; 
pstate->time=0 ; 

} 

if  (Iength_output_fifo(0)==maxlength_output_fifo(0) )  return(O) ; 

while(length_input_fifo(0)  >  3) 

{ 

if ( lcngth_output_f if o ( 0 ) ==maxlength_output_f i f o ( 0 ) )  return ( 0 ) 

get(0, &Iinp_wl) ; 

get ( 0 , &Qinp_wl ) ; 

get ( 0 , & I inp_w2 ) ; 

get ( 0 , &Qinp_w2 ) ; 

ql=Iinp_wl*Iinp_wl+Qinp_wl*Qinp_wl ; 
q2=Iinp_w2  *Iinp_w2+Qinp_w2  *Qinp_w2 ; 
if(ql<q2)  output=  -1;  else  output=l; 

if (pstate->time<2000) 

{ 

if(ql<q2)  fprintf  (pstate->fp, ''\n%f ,  %f\r",Iinp_w2,Qinp_w2)  ; 
else  fprintf  (pstate->fp, ''\n%f,  %f\r",  Iinp_wl,Qinp_wl)  ; 

) 

if (pstate->time==2000)  fclose(pstate->fp) ; 


return(3) ; 
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put (0, output) ; 

pstate”->time++  ; 

} 

return  ( 0 )  ; 
} 
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/*******************  BFMOD.C  ********************/ 

/*  Function  bfsk_inod()  */ 

#include  <stdio,h> 

# include  "type.h” 

# include  "star.h” 

# include  <inth.h> 

#define  PI  3.1415926535 

typedef  struct  { 
int  non; 

)  PARAM,  *PARAMPTR; 

typedef  struct  ( 

double  seed; 

)  STATE,  *STATEPTR; 

bfs]c_inod  (pparam, size,pstate,pstar) 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 
int  size; 

{ 

SAMPLE  input , Iout_wl , Qout_wl , Iout_w2 , Qout_w2 ; 
double  dquo, theta; 

if  (pstate  ==  NULL)  { 

pstate*  (STATEPTR)  alloc_state_var ( 1 , si zeof (STATE) ) ; 
if  (no_input_fifos(  )  !=1  ||  no_output_fifos (  )  !=1)  return (3 ) ; 

pstate->seed=7 ; 

) 

if  (Iength_output_fifo(0)*=maxlength_output_fifo(0) )  return(O) ; 

while (length_input_fifo(0)  >  0) 

{ 

if (Iength_output_fifo(0)==maxlength_output_fifo(0) )  return(O) ; 
get (0, & input) ; 

pstate->seed  *=  16807; 

dquo* (int) (pstate->seed/2147483647 . 0) ; 
pstate->seed  -*  dquo*2147483647 . 0 ; 
theta=2*PI*pstate->seed/2147483647 .0; 

if(input>0)  { Iout_wl=cos (theta) ;  Qout_wl*s in ( theta ) ; 

Iout_w2=0 ;  Qout_w2*0 ; ) 

else  { Iout_w2=cos (theta) ;  Qout_w2*s in (theta) ; 

lout_wl=0;  Qout_wl*0;} 

put ( 0 , Iout_wl ) ; 
put ( 0 , Qout_wl ) ; 
put ( 0 , Iout_w2 ) ; 
put ( 0 , Qout_w2 ) ; 

) 

return  (0)  ; 

} 
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/*******************  BPDEM.C  **********************/ 

/*  Function  bpsk_dein()  */ 

# include  <stdio.h> 

# include  "type.h” 

# include  "star.h” 

typedef  struct  { 
int  non; 

}  PARAM,  *PARAMPTR; 

typedef  struct  { 
int  none; 

}  STATE,  *STATEPTR; 

bpsk_dein  (pparam,size,pstate,pstar) 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 
int  size; 

{ 

SAMPLE  input , output ; 

if  (pstate  ==  NULL)  { 

pstate  =  (STATEPTR)  alloc_state_var ( 1 , sizeof (STATE) ) ; 
if  (no_input_f ifos (  )  i=i  | |  no_output_fifos (  )  !=l) 

} 

if  (Iength_output_fifo(0)“inaxlength_output_fifo(0) )  return(O)  ; 

while (length  input_fifo(0)  >  0) 

{ 

if  (Iength_output_fifo(0)==inaxlength_output_fifo(0) )  return (0) 
get (0, Sinput) ; 

if(input>0)  output=l;  else  output=  -1; 
put (0, output) ; 

} 

return  ( 0 )  ; 

} 


return ( 3 ) 
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/1fk1t1t1fifk-k**it-k1t1t1fk1iifk  BPMOD.C  ********★***********/ 

/*  Function  bpsk_mod()  */ 

#include  <stdio.h> 

# include  "type.h” 

#include  "star.h” 

typedef  struct  { 
int  non; 

}  PARAM,  *PARAMPTR; 

typedef  struct  { 
int  none; 

}  STATE,  *STATEPTR; 

bpsk_inod  (pparam, size,pstate,pstar) 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 
int  size; 

{ 

SAMPLE  input , output ; 

if  (pstate  ==  NULL)  { 

pstate  =  (STATEPTR)  alloc_state_var (1, sizeof (STATE) ) ; 
if  (no_input_fifos (  )  !=l  | |  no_output_fifos (  )  !=1)  return (3) 
} 

if  (Iength_output_fifo(0)*=maxlength_output_fifo(0) )  return(O) ; 

while (length_input_fifo(0)  >  0) 

{ 

if (length_output_fifo(0) ==maxlength_output_fifo(0) )  return(O) ; 
get (0,& input) ; 
output=input ; 

put (0, output) ; 

} 

return  ( 0 )  ; 

) 
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/********************  BSC.C  **************************/ 

/*  Function  bsc()  */ 

#  include  "type.h” 

#  include  •’star.h” 

#  include  <stdio.h> 

#  include  <mth.h> 

typedef  struct  { 

int  sainp_stop; 
int  seed; 
double  stdev; 

}  PARAM, *PARAMPTR; 

typedef  struct  { 

int  sainple_no; 
int  sainp_stop; 
double  sample_temp; 
float  epsilon; 

}  STATE, *STATEPTR; 

bsc(pparam, si2e,pstate,pstar) 
int  size; 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 

{ 

FILE  *fopen() ,*fl,*f2; 

SAMPLE  signal, output; 
float  vl; 
double  dquo; 
int  i; 

if  (pstate  ==  NULL  )  { 

pstate= (STATEPTR)  alloc_state_var (1, sizeof (STATE) ) ; 

pstate->sainple_no  =  0; 

ps tat e->  samp 1 e_t emp=ppar am- >seed ; 

if (size  ==  0)  pstate->samp_stop  =  100; 

else  if (size  ==  sizeof (PARAM) )  pstate->samp_stop  =  pparam->samp_stop ; 

else  return (1) ; 

f l=fopen ( "channel . tdt" , ”r” ) ; 

f 2=f open ( "pbresult . dat " , ”w" ) ; 
fscanf (fl,  ”%f" , &pstate->epsilon) ; 
fclose(fl) ; 

printf("\n  BINARY  SYMMETRIC  CHANNEL  \n"); 
fprintf (f2, ”\n  BINARY  SYMMETRIC  CHANNEL  \n  \r"); 

printf("\n  BSC  Crossover  Probability  =  %9.6f  \n” ,pstate->epsilon) ; 
fprintf (f2 , "\n  BSC  Crossover  Probability  =  %9.6f  \n  \r” , pstate->epsilon) ; 
fclose(f2) ; 

if (no_output_fifos()  !=  1)  return (2) ; 
if (no_input_fifos()  !=  1)  return (3 ) ; 

) 
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if  (length_output_fifo(0)  ==  inaxlength_output_fifo(0) )  return ( 0)  ; 

if  (pstate->sainple_no  >=  pstate->sainp_stop)  return  ( 99 )  ; 

while (length_input_f if o(0)  >0) 

{ 

if (length_output_fifo(0)  ==  maxlength_output_f ifo (0) ) 

get (0, Ssignal) ; 

pstate->sainple_teinp  *=  16807; 

dquo=(int) (pstate->sample_temp/2147483647 . 0) ; 
pstate->sainple_teinp  -=  dquo*2 147483 647.0; 
vl=pstate->saniple_temp/2147483647 . 0 ; 

if (vl>pstate->epsilon)  output=  signal; 
else  output=  -signal; 

put (0, out put) ; 

pstate->saiiiple_no++ ; 

} 

return (0) ; 

} 


return (0) ; 
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/******************  CBSC.C  **********************/ 

/*  Function  bsc()  */ 

#  include  "type.h'' 

#  include  "star.h” 

#  include  <stdio.h> 

#  include  <mth . h> 

typedef  struct  ( 

int  samp_stop; 
int  seed; 
double  stdev; 

)  PARAM,*PARAMPTR; 

typedef  struct  { 

int  sample_no; 
int  samp_stop; 
double  sainple_teinp; 
float  epsilon; 

}  STATE, * STATE PTR; 

bsc (pparam, size, pstate , pstar) 
int  size; 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 

{ 

FILE  *fopen() , *fl, *f2 ; 

SAMPLE  signal , output ; 
float  vl; 
double  dquo; 
int  i; 

if  (pstate  ==  NULL  )  { 

pstate= (STATEPTR)  alloc_state_var(l,sizeof (STATE) ) ; 
pstate->sample_no  =  0; 
pstate->sample_temp=pparam->seed; 

if (size  ==  0)  pstate->samp_stop  =  100; 

else  if (size  ==  sizeof (PARAM) )  pstate“>samp_stop  =  pparam->samp_stop; 

else  return (1) ; 

f l=f open ( "channel. tdt”, ”r”)  ; 

f 2=f open ( "pbresult . dat " , "w" ) ; 
fscanf (fl,  "%f" , &pstate->epsilon) ; 
fclose(fl) ; 

printf("\n  BINARY  SYMMETRIC  CHANNEL  \n"); 
fprintf (f2,"\n  BINARY  SYMMETRIC  CHANNEL  \n  \r") ; 

printf("\n  BSC  Crossover  Probability  =  %9.6f  \n" ,pstate->epsilon) ; 
fprintf (f 2, "\n  BSC  Crossover  Probability  =  %9.6f  \n  \r" , pstate->epsilon) ; 
fclose(f2) ; 

if (no_output_fifos()  !=  1)  return (2 ) ; 
if (no_input_fifos()  !=  l)  return (3) ; 

) 
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if (length_output_fifo(0)  ==  inaxlength_output_f ifo (0) )  return (0) ; 

if  (pstate->sample_no  >=  pstate->sainp_stop)  return(99)  ; 

while(length_input_fifo(0)  >1) 

{ 

if (length_output_fifo(0)  ==  maxi ength_outpu t_f ifo (0) ) 

get (0, fisignal) ; 

pstate->sample_temp  *=  16807; 
dquo=(int) (pstate->sample_temp/2147483647 . 0) ; 
pstate->sample_temp  -=  dquo*2147483647 . 0 ; 
vl=pstate->sample_temp/2 147483647 . 0 ; 

if (vl>pstate->epsilon)  output=  signal; 

else  output=  -signal ; 

put (0, output) ; 

get (0, &signal) ; 

pstate->sample_temp  *=  16807; 
dquo=(int) (pstate->sample_temp/2147483647 . 0) ; 
pstate->sample_temp  -=  dquo*2147483647 . 0 ; 
vl=pstate->sample_temp/2 14  7  483647.0; 

if (vl>pstate->epsilon)  output=  signal; 

else  output=  -signal; 

put (0, output) ; 

pstate->sample_no++ ; 

) 

return (0)  ; 

} 


return (0) 
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/******  C0NV3.C  (ENCODER  FOR  (3,1/2)  CONVOLUTIONAL  CODE)  *******/ 

/*  Function  conv()  */ 

# include  <stdio.h> 

# include  "type.h" 

# include  ''star.h” 

typedef  struct  { 
int  non; 

)  PARAM,  *PARAMPTR; 

typedef  struct  { 
int  s [ 3 ] ; 

)  STATE,  *STATEPTR; 

conv  (pparam, si2e,pstate,pstar) 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 
int  size; 

{ 

SAMPLE  input , outputO , outputl ; 
int  i; 

if  (pstate  ==  NULL)  { 

pstate  =  (STATEPTR)  alloc_state_var(l,sizeof (STATE) ) ; 
if  (no_input_fifos(  )  !=1  | I  no_output_fifos (  )  !=2)  return(3) 
for (i=0;i<3 ;i++)  pstate->s[i]=0; 

} 

if  (Iength_output_fifo(0)==maxlength_output_fifo(0) )  return (0) ; 
if  (length_output_fifo(l)==maxlength_output_fifo(l) )  return (0) ; 

while (length_input_f if 0(0)  >  0) 

{ 

if ( length_output_f ifo (0) ==maxlength_output_f ifo (0) )  return (0) ; 

if  ( length_output_f ifo ( 1) ==maxlength_output_f ifo ( 1) )  return (0) ; 

get (0, & input) ; 
put ( 1 , input) ; 

for(i=l;i>=0;i — )  pstate->s[i+l]=pstate->s[i] ; 

pstate->s  [  0 ]  =s  ( int)  input ; 

output0= (pstate->s [ 0 ] +pstate->s [ 2 ] ) %2 ; 

outputl= (pstate->s [ 0 ] +pstate->s [ 1 ] +pstate->s [ 2 ] ) %2 ; 

outputO=2*outputO-l ; 

output 1=2 *output 1-1 ; 

put ( 0 , outputO ) ; 
put(0, outputl) ; 

) 

return  ( 0 )  ; 

} 
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/******  C0NV7.C  (ENCODER  FOR  (7,1/2)  CONVOLUTIONAL  CODE)  *******/ 

/*  Function  conv()  */ 

# include  <stdio.h> 

# include  "type.h” 

# include  "star.h" 

typedef  struct  ( 
int  non; 

}  PARAM,  *PARAMPTR; 

typedef  struct  ( 
int  s [ 7 ] ; 

}  STATE,  *STATEPTR; 

conv  (pparam, size,pstate,pstar) 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 
int  size; 

{ 

SAMPLE  input, outputO,outputl; 
int  i; 

if  (pstate  ==  NULL)  { 

pstate  =  (STATEPTR)  alloc_state_var(l,sizeof (STATE) ) ; 
if  (no_input_fifos(  )  1=1  | |  no_output_fifos(  )  1=2)  return (3) ; 
for ( i=0 ; i<7 ; i++)  pstate->s [ i ] =0 ; 

) 

if  (Iength_output_fifo(0)==maxlength_output_fifo(0) )  return(O) ; 
if  (length_output_fifo(l)==maxlength_output_fifo{l) )  return(O) ; 

while(length_input_fifo(0)  >  0) 

{ 

if (Iength_output_fifo(0)==maxlength_output_fifo(0) )  return(O) ; 
if  (length_output_fifo(l)==maxlength_output_fifo(l) )  return(O) ; 
get (0, & input) ; 
put (1, input) ; 

for(i=5;i>=0;i — )  pstate->s[i+l]=pstate->s[i] ; 
pstate->s [ 0 ] = ( int) input ; 

outputO= (pstate->s [ 0 ] +pstate->s ( 2 ] +pstate->s [ 5 ] +pstate->s [ 6 ] +pstate->s [ 3 ] ) %2 
outputl= (pstate->s [ 0 ] +pstate->s [ 1 ] +pstate->s [ 2 ] +pstate->s [ 3 ] +pstate->s [ 6 ] ) %2 

output0=2  *outputO-l ; 
output 1=2 *output 1-1 ; 
put (0,output0) ; 
put (0, output 1) ; 

) 

return  ( 0 )  ; 

} 
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/**************************  DCONV.C  ***************************/ 

/*  Function  display ()  */ 

/*  Calculates  error  probability  for  Viterbi  decoded  convolutional 
coded  systems.  Writes  results  to  PBRESULT.DAT  file. 

*/ 

# include  "type.h” 

# include  "star.h” 

# include  <stdio.h> 

#define  LT  32 

typedef  struct  { 

int  sample_stp; 
int  seed; 

}  PARAM,  *PARAMPTR; 
typedef  struct  { 

float  time;  /*  holds  current  time,  which  is  printed  */ 
float  time_scale; 
int  errdc,errva; 

int  vi[LT] ; 
int  log2M; 
int  ser,ser2; 
int  sample_stp; 

FILE  *fo,  *fl,  *f2; 

}  STATE,  *STATEPTR; 

display ( pparam, size , pstate , pstar ) 

PARAMPTR  pparam; 

int  size;  /*  size  of  parameter  storage  */ 

STATEPTR  pstate; 

STARPTR  pstar; 

{ 

SAMPLE  x,y; 

FILE  *fopen( ) , *fp; 
int  i , j ; 
float  disp,tmp; 

if (pstate  ==  NULL)  { 

pstate  =  (STATEPTR)  alloc_state_var(l,sizeof(STATE)); 
if (no_input_fifos()  !*  2)  return ( 1) ; 
if (no_output_fifos()  !=  O)  return (2 ) ; 
pstate->time_scale  =  1.0; 

if(size<=0)  return (2 04 ) ; 

pstate->sample_stp=pparam->sample_stp; 

pstate->time  =  0.0; 

pstate->ser=0 ; 

pstate->ser2=0 ; 

pstate->crrva=0 ; 

pstate->errdc=0 ; 

fp=f open ( "modsize . tdt” , "r” ) ; 
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pstate->fo=fopen( ''pbresult.dat'',  "a”)  ; 
pstate->f  l=f open  ( "pb . dat” ,  '•w” )  ; 
pstate->f 2=f open ( "ps . dat” , ”w” ) ; 
fscanf ( fp, ”%f ” , Stmp) ; 
pstate->log2M= ( int ) tmp ; 
fclose(fp) ; 

/♦printf ("XnComparison  Delay  =  %d\n\n” , LT) ; */ 
printf(”\n  \n”) ; 

for ( i=0 ; i<LT ; i++)  pstate->vi [ i ] =0 ; 

) 


if (length_input_fifo(0)  !=  length_input_fifo(l) )  return(O); 
while (length_input_fifo(0) >0) 

( 

get (1, &x) ; 
get(0,&y) ; 

if  ( ( (int) pstate->tiine)  %pstate->log2M==0) 

{ if (pstate->ser>0)  pstate->ser2++;  pstate->ser=0 ; ) 
for (i=LT-2 ;i>=0;i — )  pstate->vi[i+l]=pstate->vi[i] ; 
pst  ate->v  i  [  0  ]  =  ( int )  X ; 
if (Dstate->vi[LT-l]  !=  (int)y) 

{p&cate->ser++ ;  pstate->errva++ ;  } 

if ( ( int) pstate->time>0) 

if  ( (int)pstate->time%(pstate->sainple_stp/100)==0)  { 
disp*pstate->errva/pstate->tiine; 
printf (”Pb*%9.6f  ”,disp); 

fprintf  (pstate->fl,  ”\n  %9.6f,  %9.6f\r”,pstate->tiine,disp)  ; 
if  ( (int) pstate->time  ==  pstate->saniple_stp)  { 
fprintf (pstate->fo, ”\n  \r”) ; 

fprintf (pstate->fo, ”\n  Bit  Error  Probability  =  %9.6f  \r”,disp); 

) 

disp=pstate->ser2/  (pstate->tiine/pstate->log2M)  ; 
printf(”  Ps=%9.6f  \r”,disp); 

fprintf  (pstate->f2 ,  ”\n  %9.6f,  %9.6f\r”,pstate->tiine,disp)  ; 
if ( ( int) pstate->time  ==  pstate->sample_stp)  { 
fprintf (pstate->fo, ”\n  \r”) ; 

fprintf (pstate->fo, ”\n  Symbol  Error  Probability  =  %9.6f  \r",disp); 

> 


pstate->time  +=  1; 
) 

return (0)  ; 

) 
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/**************************  DUNC.C  ***************************/ 

/*  Function  display ()  */ 

/*  Calculates  error  probability  for  uncoded  and  Reed  Solomon 
coded  systems.  Writes  results  to  PBRESULT.DAT  file. 

*/ 

#include  "type.h” 

#include  "star.h” 

# include  <stdio.h> 

typedef  struct  { 

int  sample_stp; 
int  seed; 

)  PARAM,  *PARAMPTR; 
typedef  struct  { 

float  time;  /*  holds  current  time,  which  is  printed  */ 
float  time_scale; 
int  errva; 
int  log2M; 
int  ser,ser2; 

int  sample_stp; 

FILE  *fo,  *fl,  *f2; 

)  STATE,  *STATEPTR; 

display (pparam, size , pstate, pstar) 

PARAMPTR  pparam; 

int  size;  /*sizeof  parameter  storage  */ 

STATEPTR  pstate; 

STARPTR  pstar; 

{ 

SAMPLE  x,y; 

FILE  *fopen() , *fp; 
int  i , j  ; 
float  disp,tmp; 

if (pstate  ==  NULL)  { 

pstate  =  (STATEPTR)  alloc_state_var(l,sizeof(STATE)); 
if (no_input_fifos()  1=  2)  return(l); 
if (no_output_fifos()  !=  0)  return (2 ) ; 
pstate->time_scale  =  1.0; 

if(size<=0)  return ( 204 ) ; 

pstate->sample_stp=pparam->sample_stp; 

pstate->time  =  0.0; 
pstate->ser=0 ; 
pstate->ser2=0 ; 
pstate->errva=0 ; 
fp=fopen('*modsize.tdt’',  ‘'r”)  ; 
pstate->fo=fopen(”pbresult.dat'',  "a")  ; 
pstate->fl=fopen(”pb.dat”, "w") ; 
pstate->f 2=f open ( "ps . dat” , ) ; 
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fscanf  (fp,  ••%£”,  strop)  ; 
pstate->log2M= ( int) trop ; 
fclose(fp) ; 

printf(''\n  \n'')  ; 

) 

if (length_input_fifo(0)  !=  length_input_fifo(l) )  return ( 58 ) ; 
while (length_input_fifo(0) >0' 

{ 

get (1, Sx) ; 
get(0,Sy) ; 

if ( ( ( int) pstate->tiroe) %pstate->log2M==0) 

{ if (pstate->ser>0)  pstate->ser2++;  pstate->ser=0 ; } 
if((int)x  !=  {int)y) 

{pstate->ser++;  pstate->errva++;  } 

if ( ( int) pstate->tiroe>0) 

if ( (int)pstate“>tiroe%(pstate->sarople_stp/100)==0)  { 
disp=pstate->errva/pstate->tiroe ; 
printf ('•Pb=%9.6f  '•,disp); 

fprintf  (pstate->f  1 , ''\n  %9.6f,  %9.6f\r*',pstate->tiroe,disp)  ; 
if ( (int)pstate“>tiroe  ==  pstate->sarople_stp)  { 
fprintf  (pstate->fo, ''\n  \r''); 

fprintf  (pstate->fo, ''\n  Bit  Error  Probability  =  %9.6f  \r",disp); 

} 

disp=pstate->ser2/ (pstate->tiroe/pstate->log2M) ; 
printf ('•  Ps=%9.6f  \r'',disp); 

fprintf  (pstate->f2 ,  ”\n  %9.6f,  %9.6f\r'',pstate->tiroe,disp)  ; 
if { (int) pstate->tiroe  ==  pstate->sarople_stp)  { 
fprintf (pstate->fo, "\n  \r”) ; 

fprintf  (pstate->fo, '*\n  Syrobol  Error  Probability  =  %9.6f  \r'',disp); 
) 


pstate->tiroe  +=  1; 

) 

return (0)  ; 

} 
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/**********************  GAUSS. C  ************************/ 

/*  Function  gauss ()  */ 

/*  This  function  generates  a  sequence  of  Gaussian  random  variables 
of  given  Std.  dev.  and  zero  mean.  File  Parameter  Version. 

*/ 

# include  "type.h" 

# include  "star.h” 

# include  <stdio.h> 

# include  <mth.h> 

typedef  struct  { 

int  samp_stop , seed ; 
double  stddev; 

)  PARAM,  *PARAMPTR; 

typedef  struct  { 

int  sample_no;  /*  current  sample  number  */ 

int  samp_stop;  /*  stop  after  this  no.  of  samples  */ 

double  sample_temp; 

}  STATE,  *STATEPTR; 

gauss (pparam, size , pstate , pstar ) 

PARAMPTR  pparam; 

int  size;  /*  size  of  parameter  storage  */ 

STATEPTR  pstate; 

STARPTR  pstar; 

{ 

float  vl , v2 , t , SNo , Rb , snr , EbNo , code_rate , tmp , f c ; 
int  log2M,L,Ll,L2; 
double  dquo; 

FILE  *fopen() ,*fl,*f2,*f3,*f4,*f5,*f6,*f7,*f8; 

SAMPLE  bis; 

if (pstate  ==  NULL) 

{ 

pstate  =  (STATEPTR)  alloc_state_var(l, si zeof (STATE) ) ; 
pstate->sample_no  =  0; 
pstate->sample_temp=pparam->seed; 

if (size  ==  0)  pstate->samp_stop  =  100; 

else  if (size  ==  sizeof (PARAM) )  pstate->samp_stop  =  pparam->samp_stop ; 

else  return (1) ; 

/*  First  determine  whether  source  is  random  bit  */ 

f5=fopen('’sou_con.  tdt” ,  "r”)  ; 
fscanf  ( f  5 ,  '•%f ,  &tmp)  ; 

L2=(int) tmp; 
fclose(f5) ; 

/*  L2  =®  0  for  random  bit,  L2=l  otherwise  */ 

/*printf("\n  L2  =  %d  '•,L2);V 
/*  Next  read  in  S/No  */ 
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f2=fopen ( "channel .tdt” , "r”) ;  /*  SNo  */ 

fscanf ( f2 , "%f " , &SNo) ; 
f close (f 2) ; 

/*  Open  Results  Output  File  PBRESULT.DAT  */ 
f 8=f open ( "pbresult . dat" , "w" ) ; 

printf{"\n  ADDITIVE  WHITE  GAUSSIAN  NOISE  CHANNEL"); 
printf("\n  S/No  =  %10.2f  dB  ",SNo); 

fprintf (f8, "\n  ADDITIVE  WHITE  GAUSSIAN  NOISE  CHANNEL  \r"); 
fprintf (f8,"\n  \r"); 

fprintf (f 8, "\n  S/No  =  %10.2f  dB  \r",SNo); 
if(L2  ==  0)  { 

/*printf("\n  Random  Bit  Source");*/ 
f l=f open ("source. tdt" , "r") ;  /*  Rb  */ 

f 3=f open ("coderate. tdt" , "r") ;  /*  code_rate  */ 

f4=fopen("modsize. tdt" , "r") ;  /*  log2M  */ 

fscanf (fl, "%f" , &Rb) ; 
fscanf ( f3 , "%f " , &code_rate) ; 
fscanf (f 4, "%f",&tmp) ; 
log2M= ( int) tmp ; 
fscanf (f 4, "%f",&tmp) ; 

L*(int) tmp; 

/*  L  =  0  for  signal  vector  modulations,  L  =  1  for  time  domain 
modulations 

*/ 

fclose(fl) ; 
fclose(f3)  ; 
f close (f4) ; 

printf("\n  Rb  =  %10.2f  bps  ",Rb) ; 
printf("\n  coderate  =  %10.2f  ",code_rate) ; 

/*  printf("\n  log2M  =  %d  ",log2M) ;  */ 

fprintf (f8,"\n  Rb  =  %10.2f  bps  \r",Rb); 
fprintf (f8, "\n  code_rate  =  %10.2f  \r",code_rate) ; 

if(L  ==  0)  { 

/*printf("\n  Signal  Vector  Modulation");*/ 
snr=SNo-10*logl0(Rb/ (code_rate*log2M) ) ; 
EbNo=snr-10*logl0 (code_rate*log2M) ; 

printf("\n  Es/No  =  %10.2f  dB  ",snr) ; 

printf("\n  Eb/No  =  %10.2f  dB  ",EbNo); 

fprintf (f8 , "\n  Es/No  =  %10.2f  dB  \r",snr); 
fprintf (f 8, "\n  Eb/No  =  %10.2f  dB  \r",EbNo); 
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pparam->stddev=sqrt(0.5*exp(-ln(10.0) *snr/10.0) ) ; 


if(log2M  ==  4) 

pparain->stddev  *-  sqrt(lO.O)  ; 
if(log2M  ==  6) 

pparam->stddev  *=  sqrt(42.0); 


printf(''\n  Standard  deviation  of  noise=  %f\n'' ,pparam->stddev)  ; 
fprintf  (f8 , ’'\n  Standard  deviation  of  noise=  %f  \r  \n  \r”  ,pparain->stddev) 

}  /*  end  if(L  ==  0)  */ 


if(L  ==  1)  { 

/*printf  (''\n  Filtered  Time  Domain  Modulations")  ;*/ 
f 6=f open ( "chlf Itrl . tdt" , "r» ) ; 
f 7=f open ( "chlf ltr2 . tdt" , "r" ) ; 
fscanf (f6, "%f",&tmp) ; 

Ll=(int) tmp; 


if (LI  ==  1)  { 

/*printf("\n  Filter  Spec  by  Order");*/ 
fscanf (f6,"%f",&tmp) ; 
fscanf (f6, "%f", &tmp) ; 
fscanf (f6,"%f",&fc) ; 

}  /*  end  if  (LI  ==  1)  */ 

else  { 

/*printf("\n  Filter  Spec  by  Attenuation");*/ 
f scanf ( f 7 , "%f " , &tmp) ; 
fscanf (f7,"%f",&fc) ; 

}  /*  end  else  */ 

fclose(f6) ; 
fclose(f7) ; 

snr=SNo  -  10*logl0 (fc) ; 
printf("\n  S/N  =  %10.2f  dB  ",snr); 
fprintf (f 8, "\n  S/N  =  %10.2f  dB  \r",snr); 
pparam->stddev=sqrt ( exp ( -In (10.0) *snr/ 10 . 0 ) ) ; 

printf("\n  Standard  deviation  of  noise=  %f\n" ,pparam->stddev) ; 
fprintf (f 8, "\n  Standard  deviation  of  noise=  %f  \r  \n  \r" ,pparam->stddev) 

)  /*  end  if(L  ==  1)  */ 

fclose(f8) ; 

)  /*  end  if(L2  =*  0)  */ 
if(L2  ==  1)  { 

/*printf("\n  Sinuisoidal  Source");*/ 
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/*  read  in  sinuisoidal  fs  */ 


fl=fopen ( "source. tdt” , "r”) ; 
fscanf ; 
fclose(fl) ; 

snr=SNo  -  10*logl0 (fc) ; 
printf("\n  S/N  =  %10.2f  dB  ",snr); 
pparam->stddev=sqrt(exp(-ln(10.0) *snr/10.0) ) ; 

printf("\n  Standard  deviation  of  noise=  %f\n"  ,pparain->stddev)  ; 

}  /*  end  if(L2  ==  1)  */ 


if ( no_output_f if os ( )  ! =  1 )  return ( 2 ) ; 
if (no_input_fifos()  !=  0)  return (3 ) ; 

)  /*  end  if(pstate  ==  NULL)  */ 

if (pstate->sainple_no  >=  pparam->sainp_stop)  return(99) 

if (length_output_fifo(0)  ==  inaxlength_output_f ifo (0) )  return (0); 


do  { 

do  { 

pstate->sample_teinp  *=  16807; 
dquo=(int) (pstate->sample_temp/2147483647 . 0) ; 
pstate->sainple_teinp  dquo*2147483647.0; 
vl=2*  (pstate->sainple_teinp/2147483647 . 0)  -1 ; 
pstate->sainple_teinp  *=  16807; 
dquo=(int)  (pstate->sainple_teiiip/2147483647 . 0)  ; 
pstate->saniple_teinp  -=  dquo*2147483647 . 0 ; 
v2=2*  (pstate->sainple_terap/2147483647. 0)  -1; 
t=vl*vl+v2*v2 ; 

} 

while (t  >=  1)  ; 

bis=  (SAMPLE)  ( (pparain->stddev)  *vl*sqrt(  ( (-2)  *ln(t)  )/t) )  ; 
(pstate->sample_no) ++ ; 

} 

while(put (0,bis)  ==0)  ; 

return (0) ;  /*  normal  return  */ 

} 
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/******************  GEN.C  *********************/ 

/*  Function  gen()  */ 

/*  Generates  a  sequence  of  random  bits  (0,1)  */ 

# include  "type.h” 

# include  "star.h” 

#include  <stdio.h> 

typedef  struct  { 

int  sample_stp; 
int  seed; 

}  PARAM,  *PARAMPTR; 

typedef  struct  { 

int  sample_no; 
int  sample_stop; 
double  sample_temp; 

}  STATE,  *STATEPTR; 

gen (pparam, size , pstate , pstar ) 

PARAMPTR  pparam; 
int  size; 

STATEPTR  pstate; 

STARPTR  pstar; 

{ 

double  dquo,u; 

SAMPLE  bit; 
if (pstate  ==  NULL)  ( 

pstate  “  (STATEPTR)  alloc_state_var(l,sizeof (STATE) ) ; 

pstate->sample_no  =0; 

pstate->sample_temp=pparam->seed; 

if (size  ==  0)  pstate->sample_stop  =  100; 

else  if (size  ==  sizeof (PARAM) ) 

pstate->sample_stop  =  pparam->sample_stp; 

else  return (1) ; 

if (no_output_fifos()  !=  1)  return(2) ; 
if (no_input_fifos()  !=  0)  return (3) ; 

> 

if (pstate->sample_no  >  pparam->sample_stp)  return (99) 

if (length_output_fifo(0)  ==  maxlength_output_fifo(0) )  return(O) 

while(length_output_fifo(0) <maxlength_output_fifo(0) ) 

{ 

pstate->sample_temp  *-  16807; 

dquo=(int) (pstate->sample_temp/2147483647 . 0) ; 

pstate->sample_temp  -=  dquo*2 147483647.0; 

u=pstate->sample_temp/2 147483 647 .0; 

bit=(u>=0. 5) ; 

put (0, bit) ; 

pstate->sample_no++ ; 

} 

return (0) ; 

) 
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/*******************  NOCOD. C  **********************/ 

/*  Function  nocod ()  */ 

# include  <stdio.h> 

# include  "type.h” 

# include  "star.h" 

typedef  struct  { 
int  non; 

}  PARAM,  *PARAMPTR; 

typedef  struct  { 
int  none; 

}  STATE,  *STATEPTR; 

nocod  (pparam,size,pstate,pstar) 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 
int  size; 

{ 

SAMPLE  input , output ; 

if  (pstate  ==  NULL)  { 

pstate  =  (STATEPTR)  alloc_state_var (1, sizeof (STATE) ) ; 
if  (no_input_fifos(  )  !=1  | |  no_output_f ifos (  )  \~2)  return (3) ; 
) 

if  (length_output_f ifo(O) “inaxlength_output_fifo(0) )  return(O)  ; 
if  (length_output_fifo(l)==inaxlength_output_fifo(l) )  return(O)  ; 

while (length_input_fifo(0)  >  0) 

{ 

if  (Iength_output__fifo(0)==inaxlength_output_fifo(0) )  return(O)  ; 

if  (length_output_fifo(l)==inaxlength_output_fifo(l) )  return(O)  ; 

get (0, & input) ; 

put (1, input) ; 

output=2* input- 1 ; 

put (0, output) ; 

} 

return  (0)  ; 

} 


31 


/*******************  NODEC.C  ************************/ 

/*  Function  nodec()  */ 

# include  <stdio.h> 

# include  "type.h” 

# include  "star.h" 

typedef  struct  { 
int  non; 

}  PARAM,  *PARAMPTR; 

typedef  struct  { 
int  none; 

}  STATE,  *STATEPTR; 

nodec  (pparam, size,pstate,pstar) 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 
int  size; 

{ 

SAMPLE  input , output ; 

if  (pstate  ==  NULL)  ( 

pstate  =  (STATEPTR)  alloc_state_var(l,sizeof (STATE) ) ; 
if  (no_input_fifos(  )  !=l  | |  no_output_fifos (  )  !=1) 

) 

if  (length_output_f ifo(O) ==maxlength_output_fifo(0) )  return(O) ; 

while (length_input_fifo(0)  >  0) 

{ 

if (Iength_output_fifo(0)==maxlength_output_fifo(0) )  return(O) 

get (0, & input) ; 

output= ( ( ( int ) input ) + 1 ) / 2 ; 

put (0, output) ; 

} 

return  ( 0 )  ; 

} 


return(3) ; 


32 


/********************  NO  DEM.C  **********************/ 

/*  Function  no_dem()  */  ~ 

# include  <stdio.h> 
tinclude  "type.h” 

# include  "star.h” 

typedef  struct  { 
int  non; 

}  PARAM,  *PARAMPTR; 

typedef  struct  { 
int  time; 

FILE  *fp; 

)  STATE,  *STATEPTR; 

no_dem  (pparam, size,pstate,pstar) 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 
int  size; 

{ 

SAMPLE  input , output ; 

FILE  *fopen() ; 

if  (pstate  ==  NULL)  { 

pstate  =  (STATEPTR)  alloc_state_var(l,sizeof (STATE) ) ; 
if  (no_input_fifos(  )  !=1  | |  no_output_fifos (  )  1=1) 
pstate->time=0 ; 

pstate->fp=fopen(”graf .dat”, "w") ; 

} 

if  (Iength_output_fifo(0)==maxlength_output_fifo(0) )  return(O) ; 

while (length_input_fifo(0)  >  0) 

{ 

if ( length_output_f i f o ( 0 ) ==maxlength_output_f i f o ( 0 ) )  return ( 0 ) 

get (0, &input) ; 

if (pstate->time<2000) 

{ 

if (pstate->time%2==0)  fprintf (pstate->fp, ”\n%f, ",  input) ; 
else  fprintf (pstate->fp, "  %f\r" , input) ; 

} 

if (pstate->time==2000)  fclose(pstate->fp) ; 

output= input ; 
put (0, output) ; 
pstate->time++ ; 

) 

return  (0)  ; 

) 


return (3) ; 
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/**********************  PLOTCONS . C 


**************************/ 


# include  <stdio.h> 

# include  "sci-graf .h”  /*  header  file  defining  sci-graf  constants  */ 

inain( ) 

{ 

int  count ,  dev ; 

double  xmin,  xmax,  ymin,  ymax;  /*  variables  used  in  get_pair_info  */ 
auto_select_display ( ) ; 
virtual_display (YES) ; 

/*  graph  data  in  "graf.dat”  */ 

get_pair_info(''graf  .dat” ,  Scount,  Sxmin,  Sxinax,  Symin,  &yinax)  ; 
hrange( (xmin  -  xmax)/2  -  1.0,  (xmax  -  xmin)/2  +  1.0); 
vrange((ymin  -  ymax)/2  -  1.0,  (ymax  -  ymin)/2  +  1.0); 
graph_type (ORDINARY) ; 
line_connect (NO) ; 
display_onscreen(YES) ; 

title ("SIGNAL  VECTOR  CONSTELLATION",  CENTER); 
haxis_lbl("I  AXIS",  CENTER); 
vaxis_lbl("Q  AXIS",  CENTER); 
display_window(0,900, 0, 643) ; 
graph_init() ; 

plot_pairs ( 1 ,  "graf . dat" ) ; 
graph_close ( ) ; 

} 
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/*************************  PLOTPB.C  ***************************/ 


# include  <stdio.h> 

#include  "sci-graf .h”  /*  header  file  defining  sci-graf  constants  */ 

mainO 

{ 

int  count ,  dev ; 

double  xmin,  xmax,  ymin,  ymax;  /*  variables  used  in  get_pair_info  */ 
auto_select_display 0 ; 
virtual_display (YES) ; 

/*  graph  data  in  "pb.dat”  */ 

get_pair_info ("pb.dat” ,  Scount,  &xinin,  &xmax,  &yinin,  &ymax)  ; 

hr ange (0.0,  xmax ) ; 

vrange(ymin,  ymax) ; 

graph_type (ORDINARY) ; 

line_connect (YES) ; 

display_onscreen(YES) ; 

hlbl_prec(0) ; 

vlbl_prec(6) ; 

titleC'Bit  Error  Probability”,  CENTER); 
haxis_lbl ("Simulation  Time",  CENTER); 
vaxis_lbl ("Bit  Error  Probability",  CENTER); 
display_window(0,900, 0, 643) ; 
graph_init() ; 
plot_pairs (1,  "pb.dat") ; 
graph_close ( ) ; 

) 


/it*******************  PLTRCINP.C  **************************/ 

#include  <stdio.h> 

#include  "sci-graf .h”  /*  header  file  defining  sci-graf  constants  */ 

main ( ) 

{ 

int  count ,  dev ; 

double  xmin,  xmax,  ymin,  ymax;  /*  variables  used  in  get_pair_info  */ 
auto_select_display 0 ; 
virtual_display (YES) ; 

get_pair_info("rcinp.dat'',  &count,  &xmin,  &xmax,  &ymin,  Symax)  ; 
hrange (0.0,  xmax) ; 

vrange((ymin  -  ymax)/2  -  0.25, (ymax  -  ymin)/2  +  0.25); 

graph_type( ORDINARY) ; 

line_connect (YES) ; 

display_onscreen(YES) ; 

hlbl_prec(0) ; 

vlbl_prec(2) ; 

title ("Signal  Waveform",  CENTER); 
haxis_lbl ( "Time" ,  CENTER) ; 
vaxis_lbl ( "Amplitude" ,  CENTER) ; 
display_window(0, 900, 0,643)  ; 
graph_init ( ) ; 

plot_pairs(l,  "rcinp.dat") ; 
graph_close() ; 

) 
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/**************-k***-k***  PLTRCOUT.C  ***********************/ 

# include  <stdio.h> 

#include  "sci-graf .h”  /*  header  file  defining  sci-graf  constants  */ 

main ( ) 

{ 

int  count ,  dev ; 

double  xmin,  xmax,  ymin,  ymax;  /*  variables  used  in  get_pair_info 
auto_select_display 0 ; 
virtual_display (YES) ; 

get_pair_info("rcout.dat" ,  &count,  &xmin,  &xmax,  &ymin,  &ymax) ; 
hrange(0.0,  xmax) ; 

vrange((ymin  -  ymax)/2  -  0.25, (ymax  -  ymin)/2  +  0.25); 
graph_type( ORDINARY) ; 
line_connect (YES) ; 
display_onscreen(YES) ; 
hlbl_prec(0) ; 
vlbl_prec(2) ; 

title ("Signal  Waveform",  CENTER); 
haxis_lbl ( "Time" ,  CENTER) ; 
vaxis_lbl ( "Amplitude" ,  CENTER); 
display_window(0, 900, 0, 643) ; 
graph_init ( ) ; 

plot_pairs(l,  "rcout.dat") ; 
graph_close() ; 

} 


/*********-ki,**-kifk*****i,  PLTTXINP.C  **************************/ 


# include  <stdio.h> 

#include  "sci-graf .h”  /*  header  file  defining  sci-graf  constants  */ 

main() 

{ 

int  count ,  dev ; 

double  xmin,  xmax,  ymin,  ymax;  /*  variables  used  in  get_pair_info  */ 
auto_select_display ( ) ; 
virtual_display (YES) ; 

get_pair_info("txinp.dat” ,  Scount,  &xinin,  &xinax,  Symin,  Symax)  ; 
hrange (0.0,  xmax ) ; 

vrange ( (ymin  -  yinax)/2  -  0.25,  (ymax  -  yinin)/2  +  0.25); 

graph_type( ORDINARY) ; 

line_connect (YES) ; 

display_onscreen(YES) ; 

hlbl_prec(0) ; 

vlbl_prec(2) ; 

title ("Signal  Waveform",  CENTER); 
haxis_lbl ( "Time" ,  CENTER) ; 
vaxis_lbl ("Amplitude" ,  CENTER) ; 
display_window(0, 900, 0,643)  ; 
graph_init ( ) ; 

plot_pairs(l,  "txinp.dat") ; 
graph_close() ; 

} 
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/It*************************  PLTTXOUT. C  *************************/ 


# include  <stdio.h> 

#include  "sci-graf .h"  /*  header  file  defining  sci-graf  constants  */ 

mainO 

{ 

int  count ,  dev ; 

double  xmin,  xmax,  ymin,  ymax;  /*  variables  used  in  get_pair_info  */ 
auto_select_display ( ) ; 
virtual_display (YES) ; 

get_pair_info(''txout.dat'' ,  &count,  &xmin,  fixmax,  &ymin,  &yinax)  ; 
hrange  (0.0,  xinax )  ; 

vrange(  (ymin  -  yinax)/2  -  0.25,  (ymax  -  ymin)/2  +  0.25); 

graph_type (ORDINARY) ; 

line_connect (YES) ; 

display_onscreen(YES) ; 

hlbl_prec(0) ; 

vlbljprec(2) ; 

title ("Signal  Waveform",  CENTER); 
haxis_lbl ( "Time" ,  CENTER) ; 
vaxis_lbl ( "Amplitude" ,  CENTER) ; 
display_window(0, 900, 0,643) ; 
graph_init ( ) ; 

plot_pairs ( 1 ,  "txout . dat" ) ; 
graph_close ( ) ; 

) 
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/It*********************  PROP.C  ******************************/ 

/*  Function  gauss ()  */ 

/*  File  parameter  version  with  Receiver  Noise  Power  Parameter  */ 

# include  "type.h" 

# include  "star.h” 

# include  <stdio.h> 

# include  <mth.h> 

typedef  struct  { 

int  samp_stop , seed ; 
double  stddev; 

}  PARAM,  *PARAMPTR; 

typedef  struct  { 

int  sample_no;  /*  current  sample  number  */ 

int  samp_stop;  /*  stop  after  this  no.  of  samples  */ 

double  sample_temp; 

}  STATE,  *STATEPTR; 

gauss (pparam, size,pstate,pstar) 

PARAMPTR  pparam; 

int  size;  /*  size  of  parameter  storage  */ 

STATEPTR  pstate; 

STARPTR  pstar; 

{ 

float  vl,v2,t; 
float  tmp; 

float  K1 , K2 , Rb , snr , EbNo , code_rate , SNo , No , Cr , al , a2 , a3 , a4 , a5 ; 
float  HT,HR,ST,GT,GR,fc,r,N,B; 
int  AT,FC,AT_FC,log2M,L,Ll,L2; 
double  4^quo; 

FILE  *fopen() ,*fl,*f2,*f3,*f4,*f5,*f6,*f7,*f8; 

SAMPLE  bis; 

if (pstate  ==  NULL) 

{ 

pstate  =  (STATEPTR)  alloc_state_var(l,sizeof (STATE) ) ; 
pstate->sample_no  =  0; 
pstate->sample_temp=pparam->seed; 

if (size  ==  0)  pstate->samp_stop  =  100; 

else  if (size  ==  sizeof (PARAM) )  pstate->samp_stop  =  pparam->samp_stop ; 

else  return (1) ; 

/*  First  determine  whether  source  is  random  bit  */ 

f5=fopen(''sou_con.  tdt” ,  '‘r'')  ; 
fscanf  (f5, ''%f”,&tmp)  ; 

L2=(int) tmp; 
fclose(f5) ; 

/*  L2  =  0  for  random  bit,  L2=l  otherwise  */ 

/*printf ("\n  L2  =  %d  ••,L2);*/ 
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/*  Next  Head  in  Channel  Propagation  Parameters  to  Calculate  S/No  */ 


f 2=f open ( "channel. tdt", "r") ;  /*  Propagation  Parameters  */ 

/*  Open  Results  Output  File  PBRESULT.DAT  */ 

f 8=f open ( "pbresult . dat" , "w" ) ; 

printf("\n  PROPAGATION  CHANNEL"); 
fprintf (f8, "\n  PROPAGATION  CHANNEL  \r"); 
fprintf (f8,"\n  \r") ; 

/*  Reading  the  Channel  Propagation  Parameters  from  File  CHANNEL. TDT  */ 

fscanf (f2 , "%f" , &tmp) ; 

AT_FC= ( int) tmp ; 

if(AT_FC  ”  0) { 

AT  =  1; 

FC  =  1;} 

else  if(AT_FC  ==  1) ( 

AT  =  2; 

FC  =  1;} 

else  if(AT_FC  “  2) { 

AT  =  1; 

FC  =  2;} 
else  { 

AT  =  2; 

FC  =  2;} 


fscanf (f 2, "%f",&HT) ; 
fscanf (f 2, "%f",&HR) ; 
fscanf (f 2, "%f",&ST) ; 
fscanf (f 2," %f",&GT) ; 
fscanf ( f 2 , " %  f " , &GR) ; 
fscanf (f 2, "%f",&fc) ; 
fscanf (f 2, "%f",&r) ; 
fscanf (f 2, "%f",&N) ; 
fscanf (f 2, "%f",&B) ; 
fclose(f2) ; 


/*  Print  out  all  Propagation  Parameters  */ 


printf ("\n 
printf ("\n 
printf ("\n 
printf ("\n 
printf ("\n 
dB",GT) ; 
printf ("\n 
dB" , GR) ; 
printf ("\n 
printf ("\n 
printf ("\n 
printf ("\n 


USER  CHANNEL  SPECIFICATIONS"); 

Transmitter  Antenna  Height  =  %10.2f  meters  ",HT); 

Receiver  Antenna  Height  *  %10.2f  meters  ",HR) ; 

Transmitter  Average  Power  =  %10.2f  watts  ",ST); 

Transmitter  Antenna  Gain,  relative  to  1/2  lambda  dipole  =  %10.2f 
Receiver  Antenna  Gain,  relative  to  1/2  lambda  dipole  =  %10.2f 
Carrier  Frequency  =  %10.2f  MHz  ",fc); 

Distance  between  Transmitter  and  Receiver  =  %10.2f  Km.  ",r); 
Receiver  Noise  Power  *  %10.2f  dBm  ",N); 

One-Sided  Receiver  Noise  Bandwidth  *  %10.2f  Hz  ",B); 
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if(AT==l)  printf(”\n  Open  Area");  else  printf(”\n  Suburban  Area”) ; 
if(FC==l)  printf(”\n  No  foliage”);  else  printf(”\n  Foliaged”) ; 
printf (”\n”) ; 

fprintf (f8, ”\n  USER  CHANNEL  SPECIFICATIONS  \r”); 
fprintf (f8 , ”\n  \r”) ; 

fprintf (f 8, ”\n  Transmitter  Antenna  Height  =  %10.2f  meters  \r”,HT); 

fprintf (f 8, ”\n  Receiver  Antenna  Height  =  %10.2f  meters  \r”,HR); 

fprintf (f 8, ”\n  Transmitter  Average  Power  =  %10.2f  watts  \r”,ST); 

fprintf (f 8 , ”\n  Transmitter  Antenna  Gain,  relative  to  1/2  lambda  dipole  =  ”) ; 

fprintf (f8,”%10.2f  dB  \r”,GT); 

fprintf (f 8, ”\n  Receiver  Antenna  Gain,  relative  to  1/2  lambda  dipole  =  %10.2f 
dB  \r” , GR) ; 

fprintf (f8 , ”\n  Carrier  Frequency  =  %10.2f  MHz  \r”,fc); 

fprintf (f 8, ”\n  Distance  between  Transmitter  and  Receiver  =  %10.2f  Km.  \r”,r) 
fprintf (f 8, ”\n  Receiver  Noise  Power  =  %10.2f  dBm  \r”,N); 
fprintf (f 8, ”\n  One-Sided  Receiver  Noise  Bandwidth  =  %10.2f  Hz  \r”,B); 
if(AT==l)  fprintf (f 8, ”\n  Open  Area  \r”) ;  else  fprintf (f 8, ”\n  Suburban  Area 
\r”)  ; 

if(FC==l)  fprintf (f 8, ”\n  No  foliage  \r”) ;  else  fprintf (f 8 , ”\n  Foliaged  \r") ; 
fprintf (f 8, ”\n  \r”) ; 


/*  Calculate  S/No  from  the  Propagation  Parameters'  */ 
No=exp( ( (N/10.0)-3) *ln(10.0) )/B; 
if (AT=*1) 

Kl=  -79-43. 5*logl0(r/l. 609) -30*logl0(fc/900.0) ; 

else 

Kl=  -91.7-38.4*logl0(r/1.609)-30*logl0(fc/900.0) ; 

if (FC==1) 

K2=  Kl; 

else 

K2=K1-10; 

al=HT/30.48; 
al  *=  al; 
a2=HR/3; 
a2  *=  a2; 
a3=ST/10; 

a4=GT-10*logl0 (4 . 0)  ; 

if (AT==1) 

a5=GR-3 ; 

else 

a5=GR-2 ; 

Cr=K2+10*logl0 (al*a2*a3 ) +a4+a5 ; 

SNo=Cr-10*logl0(No) ; 

printf (”\n  CHANNEL  PARAMETERS”); 
printf (”\n  S/No  =  %l0.2f  dB  ”,SNo); 
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fprintf  (f8,''\n  CHANNEL  PARAMETERS  \r'')  ; 
fprintf  ( f 8 ,  ''\n  \r'' )  ; 

fprintf (f 8," \n  S/No  =  %10.2f  dB  \r",SNo); 
if(L2  ==  0)  { 

/*printf (''\n  Random  Bit  Source");*/ 
f l=f open ( "source. tdt", "r") ;  /*  Rb  */ 

f 3=f open ( "coderate. tdt", "r") ;  /*  code_rate  */ 

f 4=f open ("modsize. tdt", "r") ;  /*  log2M  */ 

fscanf (fl,"%f",&Rb) ; 
fscanf (f 3 , "%f " , &code_rate) ; 
fscanf (f 4, "%f", &tmp) ; 
log2M= ( int ) tmp ; 
fscanf (f4 , "%f" , &tmp) ; 

L=(int) tmp; 

/*  L  =  0  for  signal  vector  modulations,  L  =  1  for  time  domain 
modulations 

*/ 

fclose(fl) ; 
f close (f 3) ; 
f close (f4) ; 

printf("\n  Rb  =  %l0.2f  bps  ",Rb) ; 
printf("\n  code_rate  =  %10.2f  " ,code_rate) ; 

/*printf("\n  log2M  =  %d  ",log2M);*/ 

fprintf (f 8, "\n  Rb  =  %10.2f  bps  \r",Rb); 
fprintf (f 8, "\n  code_rate  =  %io.2f  \r" ,code_rate) ; 


if(L  ==  0)  { 

/*printf("\n  Signal  Vector  Modulation");*/ 
snr=SNo-10*logl0 (Rb/ (code_rate*log2M) ) ; 
EbNo=snr-10*logl0 (code_rate*log2M) ; 

printf("\n  Es/No  =  %10.2f  dB  ",snr); 
printf("\n  Eb/No  =  %10.2f  dB  ",EbNo); 

fprintf (f 8, "\n  Es/No  =  %10.2f  dB  \r",snr); 
fprintf (f 8, "\n  Eb/No  =  %10.2f  dB  \r",EbNo); 


pparam->stddev=sqrt{0.5*exp(-ln(10.0) *snr/10.0) ) ; 
if(log2M  ==  4) 

pparam~>stddev  *=  sqrt(lO.O) ; 
if(log2M  «  6) 

pparam->stddev  *=  sqrt(42.0); 
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printf(''\n  Standard  deviation  of  noise=  %f\n'' ,pparam->stddev)  ; 
fprintf (f8,''\n  Standard  deviation  of  noise=  %f  \r  \n  \r'' ,pparam->stddev) 

}  /*  end  if(L  ==  0)  */ 


if(L  ==  1)  { 

/*printf (''\n  Filtered  Time  Domain  Modulations");*/ 
f 6=f open ( "chlf Itrl . tdt" , "r" ) ; 
f 7=f open ( "chlf ltr2 . tdt" , "r" ) ; 
fscanf (f6, "%f" , &tmp) ; 

Ll=(int) tmp; 

if (LI  ==  1)  { 

/*printf("\n  Filter  Spec  by  Order");*/ 
fscanf (f 6, "%f",&tmp) ; 
fscanf  (f 6,  "%f",Sttmp)  ; 
fscanf (f 6, "%f",&fc) ; 

}  /*  end  if  (LI  ==  1)  */ 

else  { 

/*printf ("\n  Filter  Spec  by  Attenuation") ;*/ 
fscanf ( f7 , "%f " , &tmp) ; 
fscanf  (f7,  "%f",Stfc)  ; 

)  /*  end  else  */ 

f close (f 6) ; 
f close (f 7) ; 

snr=SNo  -  10*logl0(fc) ; 
printf ("\n  S/N  =  %10.2f  dB  ",snr) ; 
fprintf (f 8, "\n  S/N  =  %10.2f  dB  \r",snr); 
pparam->stddev=sqrt(exp(-ln(10.0) *snr/10.0) ) ; 

printf ("\n  Standard  deviation  of  noise=  %f\n",pparam->stddev) ; 
fprintf (f 8, "\n  Standard  deviation  of  noise=  %f  \r  \n  \r" ,pparam->stddev) 


)  /*  end  if(L  ==  1)  */ 

f close (f 8) ; 

}  /*  end  if(L2  ==  0)  */ 
if(L2  ==  1)  ( 

/*printf("\n  Sinuisoidal  Source");*/ 
f l“f open ("source. tdt", "r") ; 

fscanf (fl, "%f", &fc) ;  /*  read  in  sinuisoidal  fs  */ 

fclose(fl) ; 

snr=SNo  -  10*logl0(fc) ; 

printf ("\n  S/N  =  %10.2f  dB  ",snr) ; 

pparam->stddev=sqrt(exp(-ln(10.0) *snr/10.0) ) ; 

printf("\n  Std.  deviation  of  noise=  %f\n" ,pparam“>stddev) ; 

}  /*  end  if(L2  ==  1)  */ 
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if (no_output_f ifos ( )  !=  l)  return (2) ; 
if (no_input_fifos ( )  !=  0)  return (3 ) ; 

}  /*  end  if(pstate  ==  NULL)  */ 

if  (pstate->sainple_no  >=  pparain“>sainp_stop) 
if (length_output_fifo(0)  ==  maxlength_output_fifo(0) ) 

do  { 

do  { 

pstate->sample_teinp  *=  16807; 
dquo-(int)  (pstate->sainple_teinp/2147483647 . 0)  ; 
pstate->saniple_temp  -=  dquo*2147483647. 0; 
vl=2*  (pstate->sainple_teinp/2147483647 . 0)  -1 ; 
pstate->saniple_teinp  *=  16807; 
dquo=(int)  (pstate->sainple_temp/2147483647 . 0)  ; 
pstate->saniple_temp  -=  dquo*2147483647 . 0 ; 
v2=2*  (pstate->sainple_teinp/2147483647 . 0)  -1 ; 
t=vl*vl+v2*v2 ; 

} 

while (t  >=  1) ; 

bis='(SAMPLE)  ( (pparam->stddev)  *vl*sqrt  ( { (-2)  *ln(t)  )/t) )  ; 
(pstate->saniple_no)  ++ ; 

} 

while (put (0, bis)  ==0)  ; 

return (0) ;  /*  normal  return  */ 

} 


return (99) ; 
return (0)  ; 
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/*******************  QFDEM.C  **********************/ 

/*  Function  qfsk_dem()  */ 

# include  <stdio.h> 

# include  "type.h” 

# include  "star.h” 

typedef  struct  { 
int  non; 

}  PARAM,  *PARAMPTR; 

typedef  struct  { 
int  time; 

FILE  *fp; 

)  STATE,  *STATEPTR; 

qfsk_dem  (pparam, size,pstate,pstar) 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 
int  size; 

{ 

SAMPLE  Iinp_wO ,  Iinp_wl , Qinp_wO , Qinp__wl ,  Iinp_w2 ,  Iinp_w3 , Qinp_w2 , Qinp_w3 
SAMPLE  output; 

float  q0,ql,q2,q3,max; 
int  i, point; 

FILE  *fopen(); 

if  (pstate  ==  NULL)  { 

pstate  =  (STATEPTR)  alloc_state_var (1, sizeof (STATE) ) ; 
if  (no_input_f ifos (  )  !=l  | |  no_output_fifos(  )  !=1)  return (3) 
pstate->fp=fopen(”graf .dat”, "w”) ; 
pstate->time=0 ; 

) 

if  (Iength_output_fifo(0)==maxlength_output_fifo(0) )  return(O) ; 

while (length_input_fifo(0)  >  7) 

{ 

if (Iength_output_fifo(0)==maxlength_output_fifo(0) )  return(O) ; 

get ( 0 , & I inp_wO ) ; 
get ( 0 , &Qinp_wO ) ; 
get ( 0 , & I inp_wl ) ; 
get ( 0 , &Qinp_wl ) ; 
get ( 0 , & I inp_w2 ) ; 
get ( 0 , &Qinp_w2 ) ; 
get  ( 0 ,  St  I  inp_w3 )  ; 
get ( 0 , &Qinp_w3 ) ; 

qO=Iinp_wO*Iinp_wO+Qinp_wO*Qinp_wO; 
ql=Iinp_wl*Iinp_wl+Qinp_wl*Qinp_wl; 
q2=Iinp_w2*Iinp_w2+Qinp_w2*Qinp_w2 ; 
q3=I inp_w3  *I inp_w3+Qinp_w3  *Qinp_w3 ; 

max»qO ;  point*0 ; 
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if(ql>inax)  {max=ql;  point=l;) 
if(q2>inax)  {inax=q2;  point=2;) 
if(q3>max)  {inax=q3;  point=3  ; } 

if  (pstate->tiine<2000) 

{ 

if(point==0)  fprintf  (pstate->fp, ''\n%f ,  %f\r'' ,  Iinp_wO,Qinp_wO) 
else  if(point==l)  fprintf (pstate->fp, ''\n%f,  %f\r'' , Iinp_wl,Qinp_wl) 
else  if(point==2)  fprintf  (pstate->fp,  ••\n%f,  %f\r'' , Iinp_w2 ,Qinp_w2) 
else  if(point==3)  fprintf (pstate->fp, *’\n%f,  %f\r'' , Iinp_w3 ,Qinp_w3) 
} 

if (pstate->time==2000)  fclose (pstate->fp) ; 

if ( (point&01)==l)  output=l;  else  output=  -1; 
put(0, output) ; 

if  ( ( (point»l)  &01)  ==1)  output=l;  else  output=  -1; 
put (0, output) ; 

pstate->tiine++ ; 

) 

return  (0)  ; 

} 


47 


/*******************  QFMOD.C  ********************/ 

/*  Function  qf sk__inod  ( )  */ 

# include  <stdio.h> 

# include  ''type.h” 

# include  "star.h” 

# include  <inth.h> 

Idefine  PI  3.1415926535 

typedef  struct  { 
int  non; 

)  PARAM,  *PARAMPTR; 

typedef  struct  { 

double  seed; 

}  STATE,  *STATEPTR; 

qfsk_mod  (pparam, size,pstate,pstar) 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 
int  size; 

{ 

SAMPLE  input ; 

SAMPLE  Iout_w0 , Qout_wO , Iout_Wl , Qout_^wl , Iout_w2 , Qout_w2 , Iout_w3 , Qout_w3 
double  dquo ,  theta ;  "" 

int  i; 
int  point; 

if  (pstate  ==  NULL)  { 

pstate  =  (STATEPTR)  alloc_state_var (1, sizeof (STATE) ) ; 
if  (no_input_fifos(  )  !=1  | |  no_output_f ifos (  )  !=1)  return (3) 
pstate->seed=7 ; 

} 

i f  ( length_output_f i f o ( 0 ) ==maxlength_output_f i f o ( 0 ) )  return ( 0 ) ; 

while (length_input_f if o(0)  >  1) 

{ 

if (length_output_f ifo(0)==maxlength_output_f ifo(O) )  return(O) ; 

get (0, &input) ; 
point=(input>0) ; 
get(0,&input) ; 
point  +=  2*(input>0); 

pstate->seed  *=  16807; 

dquo=(int) (pstate->seed/2147483647 . 0) ; 
pstate->seed  -=  dquo*2147483647 . 0 ; 
theta=2*PI*pstate->seed/2 147483647 . 0 ; 

if(point==0)  {Iout_wO=cos(theta) ;  Qout_w0=sin (theta) ; 
lout_wl=0 ;  Qout_wl=0 ; 

Iout_w2=0;  Qout_w2=0; 

lout  w3=0;  Qout  w3=0; 
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) 

else  if(point==l)  { Iout_wl=cos (theta) ;  Qout_wl=s in (theta) 
Iout_w0=0 ;  Qout_w0=0 ; 

Iout_w2=0 ;  Qout_w2=0 ; 

Iout_w3=0 ;  Qout_w3=0 ; 

) 

else  if(point==2)  { Iout_w2=cos (theta) ;  Qout_w2=sin (theta) 
lout_wl=0 ;  Qout_wl=0 ; 

Iout_w0=0 ;  Qout_w0=0 ; 

Iout_w3=0;  Qout_w3=0; 

) 

else  if(point==3)  { Iout_w3=cos (theta) ;  Qout_w3=s in (theta) 
lout_wl=0 ;  Qout_wl=0 ; 

Iout_w2=0;  Qout_w2=0; 

Iout_w0=0 ;  Qout_w0=0 ; 

) 

put ( 0 , Iout_wO ) ; 
put ( 0 , Qout_wO ) ; 
put ( 0 , Iout_wl ) ; 
put (0,Qout_wl) ; 
put ( 0 , Iout_w2 ) ; 
put ( 0 , Qout_w2 ) ; 
put ( 0 , Iout_w3 ) ; 
put ( 0 , Qout_w3 ) ; 

} 

return  (0)  ; 

} 
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/********************  QPDEM.C  *********************/ 

/*  Function  qpsk_dein()  */ 

# include  <stdio.h> 

# include  "type.h” 

# include  "star.h” 

typedef  struct  { 
int  non; 

}  PARAM,  *PARAMPTR; 

typedef  struct  { 
int  time; 

FILE  *fp; 

}  STATE,  *STATEPTR; 

qpsk_dem  (pparam, size,pstate,pstar) 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 
int  size; 

{ 

SAMPLE  Iinput,Qinput,output; 

FILE  *fopen(); 

if  (pstate  ==  NULL)  { 

pstate  ==  (STATEPTR)  alloc_state_var  (1 ,  sizeof  (STATE) )  ; 
if  (no_input_fifos(  )  1=1  ||  no_output_fifos(  )  1=1)  return (3 ) ; 
pstate->time=0 ; 

pstate->fp=fopen(”graf  .da+'”, "w")  ; 

) 

if  ( length_output_f if o ( 0 ) ==maxlength_output_f if o ( 0 ) )  return ( 0 ) ; 

while(length_input_fifo(0)  >  1) 

{ 

if (Iength_output_fifo(0)==maxlength_output_fifo(0) )  return(O) ; 

get (0, Slinput) ; 

if(linput>0)  output=l;  else  output=  -1; 
put(0,output) ; 
get ( 0 , &Qinput) ; 

if(Qinput>0)  output=l;  else  output=  -1; 
put (0, out put) ; 

/*  Print  Constellation  Points  to  File  */ 

if (pstate->time<?000)  fprintf (pstate->fp, "\n%f ,  %f\r" , Iinput,Qinput) ; 
if (pstate->time==2000)  fclose(pstate->fp) ; 
pstate->time++ ; 

} 

return  (0)  ; 

} 
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y  It -k  hit*  It -kit  It  It  It  h-klfk  It  it  It  It  QPMOD.C  kkkkkkkkkkkkkkkkkkkkky 

/*  Function  qpsk_inod()  */ 


# include  <stdio.h> 

# include  "type.h” 

# include  "star.h” 

#define  SCALE  0.70710678 

typedef  struct  { 
int  non; 

}  PARAM,  *PARAMPTR; 

typedef  struct  { 
int  none; 

)  STATE,  *STATEPTR; 

qpsk_mod  ( ppar am ,size,pstate,pstar) 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 
int  size; 

{ 

SAMPLE  input , loutput , Qoutput ; 
if  (pstate  ==  NULL)  { 

pstate  =  (STATEPTR)  alloc_state_var (1, sizeof (STATE) ) ; 
if  (no_input_fifos(  )  !=1  | |  no_output_fifos (  )  i=l)  return(3) 
} 

if  (Iengtb__output_fifo(0)==maxlength_output_fifo(0) )  return(O)  ; 

while (length_input_fifo(0)  >  1) 

{ 

if (Iength_output_fifo(0)==maxlength_output_fifo(0) )  return(O) ; 
get (0, & input) ; 

Ioutput=SCALE* input ; 
put ( 0 , loutput ) ; 
get (0, & input) ; 

Qoutput=SCALE* input ; 
put ( 0 , Qoutput ) ; 

) 

return  ( 0 )  ; 

) 


/****************  RCBUT.C  ******************/ 

/*  Function  rclpf()  */ 

/*  File  Parameter  Version  of  Butterworth  Filter  */ 

/*  Receiver  Filter  Application  */ 

#  include  "type.h" 

#  include  "star-h” 

#  include  <stdio.h> 

#  include  <mth.h> 

#  define  PI  3.1415926535 

#  define  L  40 

typedef  struct  { 
int  none; 

)  PARAM, *PARAMPTR; 
typedef  struct  { 

double  a0[21] ,  al[21],  a2[21],  bl[21],  b2[21],  s[21],  s_oldl[21]; 
int  N; 
int  time; 

FILE  *finp,  *fout; 

}  STATE, *STATEPTR; 

rclpf (pparam, size,pstate,pstar) 
int  size; 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 

{ 

SAMPLE  x; 
float  temp; 

double  tmp , Ap , Aa , f c , f s , f p , f a , wa , wc , wp ; 
double  dl,d2,  gamma[21],  s_old[213,  s_old2[21]; 
int  i,k,option,Tl; 
char  *calloc() ; 

FILE  *fopen(),  *fl,  *f2,  *f3,  *f4; 
if  (pstate  ==  NULL  )  { 

pstate=( STATEPTR)  alloc_state_var ( 1, sizeof (STATE) ) ; 

/*  Filter  Specifications  */ 


f  l=f open  ( "rcvf Itrl .  tdt” ,  ‘'r" )  ; 
f2=fopen(''rcvfltr2 .  tdt” ,  "r”)  ; 

fscanf  (f  1, ''%f  ” , &temp)  ;  /*  Read  Option  Type  */ 

option= ( int) temp ; 
f3=fopen(''rcfilt.dat”,  "w”)  ; 
f4=fopen(''rcdelay.dat” ,  "w”)  ; 

if  (option  ==  2)  { 

/*  Option  2  */ 

/*  Read  in  Filter  Specifications  */ 

fscanf  (f2,''%lf'',&fs)  ; 
fscanf  (f2,”%lf'',ifp)  ; 
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fscanf  (f2,''%lf'',&fa)  ; 
fscanf  (f2 , ,  &Ap)  ; 
fscanf  (f 2,  "%lf'',&Aa)  ; 

printf("\n  \n  BUTTERWORTH  RECEIVER  FILTER  \n'')  ; 
printf("\n  USER  FILTER  SPECIFICATIONS”); 
printf(”\n  Sampling  Frequency  =  %10.2f  Hz  ”,fs); 
printf(”\n  Passband  Edge  Frequency  =  %10.2f  Hz  ”,fp); 
printf(”\n  Stopband  Edge  Frequency  =  %10.2f  Hz  ”,fa); 
printf(”\n  Maximxim  Passband  Attenuation  =  %10.2f  dB  ”,Ap); 
printf(”\n  Minimum  Stopband  Attenuation  =  %10.2f  dB  ”,Aa); 

fprintf (f3, ”\n  BUTTERWORTH  RECEIVER  FILTER  \n  \r”); 
fprintf (f3,”\n  USER  FILTER  SPECIFICATIONS  \r”); 
fprintf (f 3, ”\n  Sampling  Frequency  =  %10.2f  Hz  \r”,fs); 
fprintf (f3 , ”\n  Passband  Edge  Frequency  =  %10.2f  Hz  \r”,fp); 
fprintf (f 3, ”\n  Stopband  Edge  Frequency  =  %10.2f  Hz  \r”,fa); 
fprintf (f 3, ”\n  Maximum  Passband  Attenuation  =  %10.2f  dB  \r",Ap); 
fprintf (f3 , ”\n  Minimum  Stopband  Attenuation  =  %10.2f  dB  \r",Aa); 

printf(”\n  \n  FILTER  DESIGN  RESULTS”); 
fprintf (f 3, ”\n  \n  FILTER  DESIGN  RESULTS  \r”); 

/*  Calculating  Filter  Parameters  from  Specifications  */ 

tmp=PI*fp/fs;  wp=2*sin(tmp)/cos(tmp) ; 
tmp=PI*fa/fs;  wa=2*sin(tmp)/cos(tmp) ; 

dl=exp(ln(10.0) *Ap/10) ; 
d2=exp(ln(10. 0) *Aa/10) ; 
tmp=ln( (dl-1)/ (d2-l) )/ (2*ln(wp/wa) ) ; 

for (pstate->N=l ;pstate->N<100 ;pstate->N++)  if (pstate->N>=tmp)  break; 
wc=wa/exp( (1/ (2 . 0*pstate->N) ) *ln(d2-l) ) ; 

printf(”\n  Order  =  %2d” ,pstate->N) ; 
fprintf (f3 , ”\n  Order  =  %2d  \r”,pstate->N) ; 

/*printf(”\n  wc  =  %10.5f  rad  ”,wc) ;*/ 

)  /*  end  if  option  ==  2  */ 

if  (option  ==  1)  { 

/*  Option  1  */ 

/*  Read  in  Filter  Specifications  */ 

fscanf (fl, ”%f” , &temp) ; 
pstate->N= ( int) temp ; 
fscanf (fl,”%lf”,&fs) ; 
fscanf (fl,”%lf”,&fc) ; 

printf(”\n  \n  BUTTERWORTH  RECEIVER  FILTER  \n”); 
printf (”\n  USER  FILTER  SPECIFICATIONS”) ; 
printf(”\n  Order  =  %2d” ,pstate->N) ; 
printf(”\n  Sampling  Frequency  =  %10.2f  Hz  ”,fs); 
printf(”\n  3dB  Cutoff  Frequency  =  %10.2f  Hz  ”,fc); 
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fprintf (f3,"\n  BUTTERWORTH  RECEIVER  FILTER  \n  \r''); 
fprintf (f3,''\n  USER  FILTER  SPECIFICATIONS  \r''); 
fprintf (f 3 , "\n  Order  =  %2d  \r" ,pstate->N) ; 
fprintf  (f 3,  "Xn  Sampling  Frequency  =  %10.2f  Hz  \r'',fs); 
fprintf  (f 3, ''\n  3dB  Cutoff  Frequency  =  %10.2f  Hz  \r",fc); 

/*  Calculating  Filter  Parameters  from  Specifications  */ 

tmp=PI*fc/fs;  wc=2*sin(tmp)/cos(tmp) ; 

/*printf(”\n  wc  -  %10.5f  rad  ”,wc) ;*/ 

)  /*  end  if  option  ==  1  */ 

if  (pstate->N  >=  40)  { 

printf(''\n  FILTER  ORDER  OUT  OF  RANGE"); 
return ( 3 ) ; ) 

/*scanf ("%d” , &T1) ;*/  /*  Pause  */ 


/* 

pstate->a0= (double  *)  calloc(l+pstate->N/2,sizeof (double) ) ; 
pstate->al= (double  *)  calloc(l+pstate->N/2,sizeof (double) ) ; 
pstate->a2=  (double  *)  calloc(l+pstate*'>N/2,sizeof  (double) )  ; 
pstate->bl= (double  *)  calloc(l+pstate->N/2,sizeof (double) ) ; 
pstate->b2=( double  *)  calloc(l+pstate->N/2 , sizeof (double) ) ; 
pstate->s* (double  *)  calloc(l+pstate->N/2, sizeof (double) ) ; 
pstate->s_oldl= (double  *)  calloc (l+pstate->N/2, sizeof (double) ) ; 
s_old2= (double  *)  calloc (l+pstate->N/2/ sizeof (double) ) ; 
s_old=(double  *)  calloc (l+pstate->N/2, sizeof (double) ) ; 
gamma=(double  *)  calloc (l+pstate->N/2, sizeof (double) ) ; 

*/ 

/*  Calculating  Transfer  Function  Coefficients  */ 

if (pstate->N%2==l)  /*  Filter  Order  N  is  odd  */ 

{ 

for  (k=pstate->N+l;k<=l.  5*pstate->N+l;)c++) 
gamma [k-pstate->N-l]=wc*cos( (k-1) *PI/pstate“>N) ; 

)  /*  end  odd  N  */ 

else  /*  Filter  Order  N  is  even  */ 

{ 

for ( k=pstate“>N+ 1 ; k<= ( 3  *pstate->N+l ) /2 ; k++ ) 

gamma [k-pstate->N]=wc*cos( (2*k-l) *PI/ (2*pstate->N) ) ; 

}  /*  end  even  N  */ 


/*printf(”\n  \n  Filter  Coefficients:");*/ 
fprintf (f 3, "\n  \n  Filter  Coefficients;  \r") ; 

/*  Generate  the  Filter  Coefficients  for  the  First  Order  Section  */ 

if (pstate“>N%2==l)  { 
pstate->a0[0]=  wc/(2+wc); 
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pstate->al [ 0 ] =  pstate->aO [ 0 ] ; 
pstate->bl[0]=  -(2-wc)/(2+wc) ; 
pstate->s [ 0 ] =0 ; 

/* 

printf(''\n  \n  a0[0]  =  %10.5e  , pstate->a0 [ 0 ] )  ; 

printf(''\n  al[0]  =  %10.5e  ",pstate“>al[0] )  ; 
printf(''\n  bl[0]  =  %10.5e  '',pstate“>bl[0] )  ; 

*/ 

fprintf (f3,''\n  \n  a0[0]  =  %10.5e  \r'',pstate->a0[0]); 
fprintf (f3,''\n  al[0]  =  %l0.5e  \r'',pstate->al[0]); 
fprintf  (f 3, ''\n  bl[0]  =  %l0.5e  \r",pstate->bl[0]); 

/*scanf (”%d",&Tl) ;*/  /*  Pause  V 

}  /*  end  if  pstate->N%2==l  */ 

/*  Generate  the  Filter  Coefficients  for  the  Second  Order  Sections  */ 

for (i=l; i<=pstate->N/2 ; i++) 

{ 

tmp  =  4-4*ganuna[i]+wc*wc; 
pstate->aO[i]=  wc*wc/tmp; 
pstate->al [ i ] =  2  *pstate->a0 [ i ] ; 
pstate->a2 [i]=  pstate->aO[i] ; 
pstate->bl[i]=  -2* (4-wc*wc)/tmp; 
pstate->b2 [ i ] =  ( 4+4  *garama [ i ] +wc*wc) /tmp ; 
pstate->s[i]=0; 
pstate->s_oldl [ i ] =0 ; 

/* 

printf(''\n  \n  a0[%d]  =  %10.5e  ",  i,pstate->aO[i] )  ; 
printf(”\n  al[%d]  =  %10.5e  ” , i,pstate->al [i] ) ; 
printf("\n  a2[%d]  =  %10.5e  ",i,pstate->a2[i] ) ; 
printf("\n  blt%d]  =  %10.5e  ",i,pstate->bl[i] ) ; 
printf("\n  b2[%d]  =  %10.5e  " , i,pstate->b2 [i] ) ; 

*/ 

fprintf (f 3 , ”\n  \n  a0[%d]  =  %10.5e  \r", i,pstate->aO[i] ) ; 
fprintf (f3 , ”\n  al[%d]  =  %10.5e  \r",i,pstate->al[i]) ; 
fprintf (f 3, ”\n  a2[%d]  =  %10.5e  \r",i,pstate->a2[i]) ; 
fprintf (f 3, "\n  bl[%d]  =  %l0.5e  \r",i,pstate->bl[i] ) ; 
fprintf (f 3, ”\n  b2[%d]  =  %10.5e  \r",i,pstate->b2[i]) ; 

/*scanf (”%d",&Tl) ;*/  /*  Pause  */ 

) 

fprintf (f 4 , "%3d  \n  \r" ,pstate->N) ;  /*  print  filter  delay  in  file  */ 

if (no_output_fifos()  !=  1)  return (2 ) ; 
if (no_input_fifos()  !=  1)  return (3 ) ; 

pstate->tiine=0 ; 

pstate->finp=fopen("rcinp.dat”, "w”) ;  /*  filter  input  data  file  */ 

pstate->fout=fopen(”rcout.dat” , ”w”) ;  /*  filter  output  data  file  */ 
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fclose(fl) ; 

£close(f2) ; 

£close(f3) ; 

£close(£4) ; 

}  /*  end  if  (pstate  ==  NULL)  */ 

if  (length_output_fifo(0)  ==  maxlength__output_f ifo(O) )  return ( 0)  ; 
if (length_input_fifo(0)  <1)  return ( 0) ; 

while (length_input_fifo(0)  >0) 

{ 

if (length_output_fifo(0)  ==  inaxlength_output_fifo(0) )  return ( 0) ; 
get (0, &x) ; 

/*  Write  Filter  Input  Data  to  File  */ 
if (pstate->time<4*L) 

fprintf  (pstate->finp, ''\n  %f,  %f\r”,  (float )pstate->tiine,x)  ; 
if  (pstate->tiine==4*L-l)  fclose (pstate->f inp)  ; 

/*  Generate  Filter  Output  */ 

if (pstate->N%2==l) 

{ 

s_old [ 0 ] *pstate->s [ 0 ] ; 

pstate->s [ 0 ] =x-pstate->bl ( 0 ] *s_old [ 0 ] ; 

x*pstate->a0 [ 0 ] *pstate->s ( 0 ] +pstate->al [ 0 ] *s_old [ 0 ] ; 

} 

if (pstate->N>l) 

for ( i=l ; i<=pstate->N/2 ; i++) 

{ 

s_old2 [i]=pstate->s_oldl[i] ; 
pstate->s_oldl [ i ] =pstate->s [ i ] ; 

pstate->s  [  i ]  =x-pstate->bl  [  i ]  *pstate->s_oldl  [  i  ]  -'pstate->b2  [  i  ]  *s_old2  [  i  ] 
x=pstate->a0 [ i ] *pstate->s [ i ] +pstate->al [ i ] *pstate->s_oldl [ i ] 
+pstate->a2 [ i ] *s_old2 [ i ] ; 

} 

put(0,x) ; 

/*  Write  Filter  Output  Data  to  File  */ 
if  (pstate->tinie<4*L) 

fprintf  (pstate->fout,  "\n  %f,  %f\r'',  (float  )pstate->time,x)  ; 
if (pstate->time==4*L-l)  fclose (pstate->fout) ; 

pstate->tiine++  ; 

) 

return (0) ; 

) 
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/It******************  RCCHEB.C  ************************/ 
/*  Function  rclpf()  */ 

/*  File  Parameter  Version  of  Chebychev  Filter  */ 

/*  Receiver  Filter  Application  */ 


#  include  "type.h” 

#  include  "star.h” 

#  include  <stdio.h> 

#  include  <mth.h> 

#  define  PI  3.1415926535 

#  define  L  40 

typedef  struct  { 
int  none; 

}  PARAM,*PARAMPTR; 
typedef  struct  { 

do\ible  a0[21] ,  al[21],  a2[21],  bl[21],  b2[21],  s[21],  s_oldl[21]; 
double  Ho; 
int  N; 
int  time; 

FILE  *finp,  *fout; 

}  STATE, *STATEPTR; 

rclpf (pparam, size,pstate,pstar) 
int  size; 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 

{ 

SAMPLE  x; 
float  temp; 

doxible  eps,  tmp,  Ap,Aa,  fc,  fs,  fp,  fa,wa,wp; 
double  dl,d2,  s_old[21],  s_old2[21]; 

double  sigma[83],  omega[83],  pO,  Re_p[42],  Im_p[42],  eta[42],  gamma[42] 
int  i,k,option,Tl; 
char  *cal]oc(); 

FILE  *fopen(),  *fl,  *f2,  *f3,  *f4; 
if  (pstate  ==  NULL  )  { 

pstate= (STATEPTR)  alloc_state_var (1, sizeof (STATE) ) ; 

/*  Filter  Specifications  */ 

f l=fopenr”rcvfltrl. tdt” , "r”) ; 
f 2=fopen ( "rcvf ltr2 . tdt" , "r” ) ; 

fscanf  (fl, ''%f" , &temp)  ;  /*  Read  Option  Type  */ 

option* ( int) temp ; 
f 3=f open ( "ref ilt . dat” , "w” ) ; 
f4=fopen(''rcdelay  .dat” ,  "w”)  ; 


if  (option  *=  2)  { 

/*  Option  2  */ 

/*  Read  in  Filter  Specifications  */ 
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fscanf  ; 

fscanf  (f 2,  "%lf '*,&£?)  ; 
fscanf  (f2,''%lf'',&fa)  ; 
fscanf (f 2, "%lf",&Ap) ; 
fscanf  (f 2, '•%lf'',&Aa)  ; 

printf(''\n  \n  CHEBYCHEV  RECEIVER  FILTER  \n'')  ; 
printf("\n  USER  FILTER  SPECIFICATIONS”); 
printf(”\n  Sampling  Frequency  =  %10.2f  Hz  ”,fs); 
printf(”\n  Passband  Edge  Frequency  =  %10.2f  Hz  ”,fp); 
printf(”\n  Stopband  Edge  Frequency  =  %10.2f  Hz  ”,fa); 
printf(”\n  Maximum  Passband  Attenuation  =  %10.2f  dB  ”,Ap); 
printf(”\n  Minimum  Stopband  Attenuation  =  %10.2f  dB  ”,Aa) ; 

fprintf (f3,"\n  CHEBYCHEV  RECEIVER  FILTER  \n  \r”); 
fprintf (f3,”\n  USER  FILTER  SPECIFICATIONS  \r"); 
fprintf (f 3 , "\n  Sampling  Frequency  =  %10.2f  Hz  \r”,fs); 
fprintf (f 3, ”\n  Passband  Edge  Frequency  =  %10.2f  Hz  \r",fp); 
fprintf (f 3 , ”\n  Stopband  Edge  Frequency  =  %10.2f  Hz  \r”,fa); 
fprintf (f3 , ”\n  Maximum  Passband  Attenuation  =  %10.2f  dB  \r",Ap) ; 
fprintf (f 3 , ”\n  Minimum  Stopband  Attenuation  =  %10.2f  dB  \r”,Aa) ; 

printf(”\n  \n  FILTER  DESIGN  RESULTS"); 
fprintf (f 3,” \n  \n  FILTER  DESIGN  RESULTS  \r”) ; 


/*  Calculating  Filter  Parameters  from  Specifications  */ 

tmp=PI*fp/fs;  wp=2*sin(tmp)/cos(tmp) ; 
tmp=PI*fa/fs;  wa=2*sin(tmp)/cos(tmp) ; 
eps=sqrt(exp(ln(10.0) *Ap/10) -1) ; 
dl=sqrt (exp(ln(10. 0) *Aa/10) -l)/eps; 
d2*wa/wp; 

tmp=ln(dl+sqrt  (dl*dl-l)  )/ln(d2+sqrt(d2*d2-'l) )  ; 

for (pstate->N=l;pstate->N<100 ;pstate->N++)  if (pstate->N>=tmp)  break; 

printf("\n  Order  =  %2d" ,pstate->N) ; 
fprintf (f 3, ”\n  Order  =  %2d  \r",pstate->N) ; 

/*printf(”\n  wp  *  %10.5f  rad  ",wp) ; 
printf(”\n  epsilon  =  %10.5f  ",eps);*/ 

)  /*  end  if  option  ==  2  */ 

if  (option  ==  1)  { 

/*  Option  1  */ 

/*  Read  in  Filter  Specifications  */ 

fscanf ( fl, ”%f” , &temp) ; 
pstate->N= ( int ) temp ; 
fscanf (fl,"%lf",&fs) ; 
fscanf (fl,”%lf",&fp) ; 

printf("\n  \n  CHEBYCHEV  RECEIVER  FILTER  \n") ; 
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printf(''\n  USER  FILTER  SPECIFICATIONS"); 
printf("\n  Order  =  %2d",pstate->N) ; 
printf("\n  Sampling  Frequency  *  %10.2f  Hz  ”,fs); 
printf(”\n  3dB  Cutoff  Frequency  =  %10.2f  Hz  ”,fp); 

fprintf (f3,”\n  CHEBYCHEV  RECEIVER  FILTER  \n  \r"); 
fprintf (f3, ”\n  USER  FILTER  SPECIFICATIONS  \r"); 
fprintf (f 3,” \n  Order  =  %2d  \r",pstate->N); 
fprintf (f 3 , ”\n  Sampling  Frequency  =  %10.2f  Hz  \r”,fs); 
fprintf (f 3," \n  3dB  Cutoff  Frequency  =  %10.2f  Hz  \r",fp); 

/*  Calculating  Filter  Parameters  from  Specifications  */ 

tmp=PI*fp/fs;  wp=2*sin(tmp)/cos(tmp) ; 

Ap=3 . 0 ; 

eps=sqrt ( exp ( In ( 10 . 0 ) *Ap/10) -1) ; 

/*printf("\n  wp  =  %10.5f  rad  ",wp) ; 
printf(”\n  epsilon  =  %10.5f  ",eps);*/ 


}  /*  end  if  option  ==  1  */ 


/*scanf (”%d",&Tl) ;*/  /*  Pause  */ 

if  (pstate->N  >=40)  { 

printf(”\n  FILTER  ORDER  OUT  OF  RANGE"); 
return ( 3 ) ; ) 


/* 

pstate->a0= (double  *)  calloc(l+pstate->N/2 ,sizeof (double) ) ; 
pstate->al= (double  *)  calloc(l+pstate->N/2,sizeof (double) ) ; 
pstate->a2= (double  *)  calloc(l+pstate->N/2,sizeof (double) ) ; 
pstate->bl= (double  *)  calloc(l+pstate->N/2,sizeof (double) ) ; 
pstate->b2= (double  *)  calloc(l+pstate->N/2,sizeof (double) ) ; 
pstate->s= (double  *)  calloc (l+pstate->N/2 , sizeof (double) ) ; 
pstate->s_oldl= (double  *)  calloc(l+pstate->N/2, sizeof (double) ) ; 
s_old2= (double  *)  calloc(l+pstate->N/2, sizeof (double) ) ; 
s_old=(double  *)  calloc ( 1.  t^:3tal:c->N/2 , sizeof  (:?ouble) )  ; 
sigma=(double  *)  calloc (l+2*pstate->N, sizeof (double) ) ; 
omega=(double  *)  calloc (l+2*pstate->N, sizeof (double) ) ; 

Re_p=(double  *)  calloc (l+pstate->N, sizeof (double) ) ; 

Im_p=(double  *)  calloc (l+pstate->N, sizeof (double) ) ; 
eta=(double  *)  calloc (l+pstate->N, sizeof (double) ) ; 
gamma=(double  *)  calloc (l+pstate->N, sizeof (double) ) ; 

*/ 

/*  Calculating  Transfer  Function  Coefficients  */ 
tmp=l/eps ; 

f or ( k=l ; k<=2  *pstate->N ; k++ ) 

{ 

sigma[k]= 

-sinh(ln(tmp+sqrt(tmp*tmp+l) )/pstate->N) *sin( (2*k-l) *PI/ (2*pstate->N) ) ; 
omega [k]= 

cosh(ln(tmp+sqrt (tmp*tmp+l) )/pstate->N) *cos( (2*k-l) *PI/ (2*pstate->N) ) ; 
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/*printf("\n  sigiaa(%2d)  =  %10.5e,  oinega(%2d)  =  %10.5e  ", k, sig¬ 
ma  [k]  , k, omega [k] ) ;*/ 

) 

/*printf("\n  wp  =  %10.5f  rad  ",wp);*/ 
i=l; 

f or ( k=l ; k<=2 *pstate->N ; k++ )  i f ( s Igma [ k] < 0 ) 

{Re_p[i]=sigma[k] ; 

Im_p [ i ] =omega [ k] ; 
gamma  [  i  ]  =wp*Re__p  [  i  ] ; 

eta [ i ] =wp*wp* (Re_p [ i ] *Re_p [ i ] +Im_p [ i ] *Im_p [ i ] ) ; 
i++; } 

/*for(i=l;i<=pstate->N/2 ;i++)  { 

printf("\n  Re_p(%2d)  =  %10.5e,  Im_p(%2d)  =  %10.5e  ",i,Re_p[i] ,i,Im_p[i] ) 
printf("\n  gamma(%2d)  =  %10.5e,  eta(%2d)  =  %10.5e  ", i,gamma[i] , i,eta[i] ) 
} 

*/ 

if (pstate->N%2=*l) 

{pO=sigma[ (pstate->N+l)/2 ] ; 

/*printf("\n  for  odd  N,  p[0]  =  %10.5e  ",p0);*/ 

pstate->Ho=  -pO ; } 
else 

pstate->Ho“  exp(-ln(10. 0) *Ap/20) ; 

for ( i=l ; i<=pstate->N/2 ; i++) 

pstate->Ho  *=  Re_p [ i ] *Re_p [ i ] +Im_p [ i ] *Im_p [ i ] ; 


/*scanf ("%d",fiiTl) ;*/  /*  Pause  */ 


/*printf("\n  \n  Filter  Coefficients:");*/ 
fprintf (f3, "\n  \n  Filter  Coefficients:  \r") ; 

/*  Generate  the  Filter  Coefficients  for  the  First  Order  Section  */ 

if (pstate->N%2==l)  { 
pstate->a0[0]=  wp/ (2-wp*p0) ; 
pstate->al [ 0 ] =  pstate->aO [ 0 ] ; 
pstate->bl[0]=  - (2+wp*p0)/ (2-wp*p0) ; 
pstate->s [ 0 ] =0 ; 

/* 

printf("\n  \n  a0[0]  =  %10.5e  ",pstate->a0[0] ) ; 
printf("\n  al[0]  =  %10.5e  " ,pstate->altO] ) ; 
printf("\n  bl[0]  =  %10.5e  " ,pstate->bl[0] ) ; 

*/ 

fprintf (f 3, "\n  \n  a0[0]  =  %10.5e  \r",pstate->a0[0]); 
fprintf (f 3, "\n  al[0]  =  %10.5e  \r",pstate->al[0] ) ; 


60 


fprintf  (f3 , ''\n  bl[0]  =  %10.5e  \r",pstate->bl[0] )  ; 

/*scanf  ("%d'' ,  &T1)  ;*/  /*  Pause  */ 

}  /*  end  if  pstate->N%2==l  */ 

/*  Generate  the  Filter  Coefficients  for  the  Second  Order  Sections  */ 

for ( i=l ; i<=pstate->N/2 ; i++) 

{ 

/*printf  (''\n  gamma (%2d)  =  %10.5e,  eta(%2d)  =  %10.5e  '',i,gamma[i]  ,i,eta[i])  ;*/ 
tmp  =  4-4*gamma[i]+eta[i] ; 

/*printf("\  tmp  =  %10.5e  ",tmp);*/ 
pstate->aO[i]=  wp*wp/tmp; 
pstate->al [ i ] =  2  *pstate->aO [ i ] ; 
pstate->a2 [ i ] =  pstate->aO [ i ] ; 
pstate->bl[i]=  -2* (4-eta [i] )/tmp; 
pstate->b2 [ i ] =  ( 4+4  *gamma [ i ] +eta [ i ] ) /tmp ; 
pstate->s [ i ] =0 ; 
pstate->s_oldl [ i ] =0 ; 

/* 

printf(''\n  \n  a0[%d]  =  %10.5e  ” ,  i,pstate->aO [i] )  ; 
printf(”\n  al[%d]  =  %10.5e  ,  i,pstate->al[i] )  ; 

printf("\n  a2[%d]  =  %10.5e  ”, i,pstate->a2[i] ) ; 
printf("\n  bl[%d]  =  %10.5e  ”, i,pstate->bl[i] ) ; 
printf(”\n  b2[%d]  =  %10.5e  ", i,pstate->b2[i] ) ; 

*/ 

fprintf (f 3, ”\n  \n  a0[%d]  =  %10.5e  \r”,i,pstate->aO[i] ) ; 
fprintf (f3 , ”\n  al[%d]  =  %l0.5e  \r” , i,pstate->al(i] ) ; 
fprintf (f 3, ”\n  a2[%d]  =  %10.5e  \r” , i,pstate->a2 [i] ) ; 
fprintf (f 3, ”\n  bl[%d]  =  %10.5e  \r” , i,pstate->bl[i] ) ; 
fprintf (f3 , ”\n  b2[%d]  =  %10.5e  \r” , i,pstate->b2 [i] ) ? 


) 


/*scanf (”%d” , &T1) ;*/  /*  Pause  */ 


/*printf(”\n  Ho  =  %10.5f  ”,pstate->Ho) ;*/ 
fprintf (f 3, ”\n  \n  Ho  =  %10.5f  \r",pstate->Ho) ; 


fprintf (f 4, ”%3d  \n  \r”,pstate->N) ;  /*  print  filter  delay  in  file  */ 

if (no_output_fifos()  1=  l)  return(2) ; 
if (no_input_fifos()  !*  1)  return (3 ) ; 

pstate->time=0 ; 

pstate->finp=fopen(”rcinp.dat”,”w”) ;  /*  filter  input  data  file  */ 

pstate->fout=fopen(”rcout.dat” , ”w”) ;  /*  filter  output  data  file  */ 

fclose(fl) ; 
fclose(f2) ; 
f close (f 3) ; 
fclose(f4) ; 
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}  /*  end  if  (pstate  ==  NULL)  */ 


if (length_output_fifo(0)  ==  maxlength_output_fifo (0) )  return(O); 
if (length_input_fifo(0)  <1)  return(O); 

while (length_input_f if 0(0)  >0) 

{ 

if (length_output_fifo(0)  ==  maxlength_output_f ifo (0) )  return ( 0) ; 
get(0,&x) ; 

/*  Write  Filter  Input  Data  to  File  */ 
if (pstate->time<4*L) 

f  print  f  (pstate->finp,  "\n  %f,  %f\r'',  (float)pstate->time,x)  ; 
if  (pstate->tiine==4*L-l)  f close  (pstate->finp)  ; 

/*  Generate  Filter  Output  */ 

X  *=  pstate->Ho; 

if (pstate->N%2==l) 

{ 

s_old [ 0 ] =pstate->s [ 0 ] ; 

pstate->s [ 0 ] =x-pstate->bl [ 0 ] *s_old [ 0 ] ; 

x=pstate->aO [ 0 ] *pstate->s [ 0 ] +pstate->al [ 0 ] *s_old [ 0 ] ; 

} 

if (pstate->N>l) 

for ( i=l ; i<=pstate->N/2 ; i++) 

{ 

s_old2 [ i ] =pstate->s_oldl [ i ] ; 
pstate->s_oldl [ i ] =pstate->s [ i ] ; 

pstate->s [ i ] =x-pstate->bl [ i ] *pstate->s_oldl [ i ] -pstate->b2 [ i ] *s_old2 [ i ] 
x=pstate->aO [ i ] *pstate->s [ i ] +pstate->al [ i ] *pstate->s_oldl [ i ] 
+pstate->a2 [ i ] *s_old2 [ i ] ; 

} 

put(0,x) ; 

/*  Write  Filter  Output  Data  to  File  */ 
if  (pstate->tinie<4*L) 

fprintf  (pstate->fout,  "\n  %f,  %f\r",  (float)pstate->tiine,x)  ; 
if (pstate->time==4*L-l)  fclose(pstate->fout) ; 

pstate- >time++ ; 

) 

return (0) ; 

) 
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/*******************  RCELL.C  ***********************/ 

/*  Function  rclpf()  */ 

/*  File  Parameter  Version  of  Elliptic  Filter  */ 

/*  Receiver  Filter  Application  */ 

#  include  ''type.h” 

#  include  "star.h'* 

#  include  <stdio.h> 

#  include  <mth.h> 

#  define  PI  3.1415926535 

#  define  L  40 

typedef  struct  { 
int  none; 

}  PARAM,*PARAMPTR; 
typedef  struct  { 

double  a0[21],  al[21],  a2[21],  bl[21],  b2[21],  s[21],  s_oldl[21]; 
double  Ho; 
int  r,N; 
int  time; 

FILE  *finp,  *fout; 

}  STATE, *STATEPTR; 

rclpf (pparam, size,pstate,pstar) 
int  size; 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 

{ 

SAMPLE  x; 
float  temp; 

double  tmp , Ap , Aa , f s , f p , f a , wa , wp , Aahat ; 

double  dl,d2,  s_old[21],  s_old2[21]; 

double  A0[21] ,  B0[21],  Bl[21],  V[21],  0MEGA[21]; 

double  W , k , kp , qO , q4 , q , D , LAMBDA , lambda , slambda , sigmaO , ss igmaO , mu ; 

int  i,m,option,Tl; 

char  *calloc() ; 

double  rcpowO  ; 

FILE  *fopen(),  *fl,  *f2,  *f3,  *f4; 


if  (pstate  ==  NULL  )  { 

pstate* (STATEPTR)  alloc_state_var(l, si zeof (STATE) ) ; 

/*  Filter  Specifications  */ 

fl=fopen(''rcvfltrl.tdt'' ,  ”r”)  ; 
f 2»f open ( "rcvf ltr2 . tdt” , "r” ) ; 

fscanf  (f  1, ''%f  ” ,  fitemp)  ;  /*  Read  Option  Type  */ 

option* ( int) temp ; 
f 3-f open ( "ref ilt . dat” , "w” ) ; 
f4*fopen(''rcdelay.dat'' ,  "w”)  ; 


if  (option  ==  2)  { 


63 


/*  Option  2  */ 

/*  Read  in  Filter  Specifications  */ 


fscanf  (f2,''%lf'',&fs)  ; 
fscanf  (f2,  ”%lf'',&fp)  ; 
fscanf  (f2,''%lf'',&fa)  ; 
fscanf (f 2,” %lf”,&Ap) ; 
fscanf  (f 2, ••%lf'',&Aa)  ; 

printf("\n  \n  ELLIPTIC  RECEIVER  FILTER  \n"); 
printf("\n  USER  FILTER  SPECIFICATIONS"); 
printf("\n  Sampling  Frequency  =  %10.2f  Hz  ",fs); 
printf("\n  Passband  Edge  Frequency  =  %l0.2f  Hz  ",fp); 
printf("\n  Stopband  Edge  Frequency  =  %10.2f  Hz  ",fa); 
printf("\n  Maximum  Passband  Attenuation  =  %10.2f  dB  ",Ap); 
printf("\n  Minimum  Stopband  Attenuation  =  %10.2f  dB  ",Aa); 

fprintf (f3,"\n  ELLIPTIC  RECEIVER  FILTER  \n  \r"); 
fprintf (f3,"\n  USER  FILTER  SPECIFICATIONS  \r"); 
fprintf (f 3 , "\n  Sampling  Frequency  =  %l0.2f  Hz  \r",fs); 
fprintf (f 3, "\n  Passband  Edge  Frequency  =  %10.2f  Hz  \r".fp); 
fprintf (f 3, "\n  Stopband  Edge  Frequency  =  %10.2f  Hz  \r",fa); 
fprintf (f 3, "\n  Maximum  Passband  Attenuation  =  %10.2f  dB  \r",Ap); 
fprintf (f 3 , "\n  Minimum  Stopband  Attenuation  =  %10.2f  dB  \r",Aa) ; 

printf("\n  \n  FILTER  DESIGN  RESULTS"); 
fprintf (f 3," \n  \n  FILTER  DESIGN  RESULTS  \r") ; 


/*  Calculating  Filter  Parameters  from  Specifications  */ 

tmp=PI*fp/fs;  wp=2*sin(tmp)/cos(tmp) ; 
tmp=PI*fa/fs;  wa=2*sin(tmp)/cos(tmp) ; 
k=wp/wa ; 

/*printf("\n  Filter  Selectivity  k  =  %10.5f  ",k) ;*/ 
kp=sqrt (l-k*k) ; 

q0=0. 5* (1-sqrt (kp) )/ (1+sqrt (kp) ) ; 
q4=q0*q0*q0*q0 ; 

q=q0+2*q0*q4+15*q0*q4*q4+150*q0*q4*q4*q4 ; 
dl=exp(ln(10. 0) *Ap/10) ; 
d2=exp(ln(10. 0) *Aa/10) ; 

D=(d2-l)/(dl-l) ; 
tmp=ln(16*D)/ln(l/q) ; 

for (pstate->N-l ;pstate->N<100 ;pstate->N++)  if (pstate->N>=tmp)  break; 

printf("\n  Filter  Order  N  =  %2d  ",pstate->N) ; 
fprintf (f 3 , "\n  Order  =  %2d  \r",pstate->N) ; 

if  (pstate->N  >=  40)  { 

printf("\n  FILTER  ORDER  OUT  OF  RANGE"); 
return ( 3 ) ; } 

Aahat»10. 0*logl0 ( (dl-1)/ (16.0*rcpow(q,pstate->N) )+l) ; 
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printf("\n  Actual  Stopband  Attenuation  *  %10.2f  dB  '',Aahat); 
fprintf (f3,''\n  Actual  Stopband  Attenuation  =  %10.2f  dB  \r”,Aahat); 


pstate->r=pstate->N/2 ; 
lainbda=sqrt  (k)  /wp ; 
dl=exp(ln(10. 0) *Ap/20) ; 

LAMBDA=(0.5/pstate->N)*ln( (dl+l)/(dl-l) ) ; 
for  (in=0,dl=0;m<=4  ;in++) 

dl  +=  rcpow(-l.  0,m)  *rcpow(q,ni*  (m+1) )  *sinh(  (2*in+l)  *LAMBDA)  ; 
for(m=l,d2=0;m<=5;m++) 

d2  +=  rcpow(-l.  0,in)  *rcpow(q,m*in)  *cosh(2*in*LAMBDA)  ; 

sigma0=2*sqrt (sqrt (q) ) *dl/ (l+2*d2) ; 
if(sigma0  <  0)  sigmaO  =  -sigmaO; 
ssigmaO=sigiaaO*siginaO ; 

W=sqrt ( ( l+k*ssigmaO ) * ( l+ssigmaO/k) ) ; 

/*scanf  (''%d'',&Tl)  ;*/  /*  Pause  */ 


/* 

pstate->a0= (double  *)  calloc(l+pstate->r,sizeof (double) ) ; 
pstate->al= (double  *)  calloc(l+pstate->r,sizeof (double) ) ; 
pstate->a2= (double  *)  calloc(l+pstate->r,sizeof (double) ) ; 

I  pstate->bl=  (double  *)  calloc (l+pstate->r, si  "^eof  (double) )  ; 

1  pstate->b2* (double  *)  calloc(l+pstate->r,sizeof (double) ) ; 

pstate->s= (double  *)  calloc(l+pstate->r,sizeof (double) ) ; 

,  pstate->s_oldl= (double  *)  calloc(l+pstate->r,sizeof (double) ) ; 

I  s_old2= (double  *)  calloc(l+pstate->r,sizeof (double) ) ; 

'  s_old=(double  *)  calloc (l+pstate->r, sizeof (double) ) ; 

A0=(double  *)  calloc (l+pstate->r, sizeof (double) ) ; 

I  B0=(double  *)  calloc (l+pstate->r, sizeof (double) ) ; 

I  Bl=(double  *)  calloc (l+pstate->r, sizeof (double) ) ; 

V=(double  *)  calloc (l+pstate->r, sizeof (double) ) ; 

OMEGA=(double  *)  calloc (l+pstate->r, sizeof (double) ) ; 

*/ 

/♦printf (''\n  \n  Filter  Coefficients:”);*/ 
fprintf (f 3 , ”\n  \n  Filter  Coefficients:  \r”) ; 

/*  Generate  the  Filter  Coefficients  for  the  First  Order  Section  */ 

if (pstate->N%2==l)  { 

tmp-sigmaO/lambda ; 
pstate->a0[0]=  1/ ( (2+tinp)  *  lambda)  ; 
pstate->al[0]=  pstate->a0[0] ; 
pstate->bl[0]=  - (2-tmp)/ (2+tmp) ; 
pstate->s [ 0 ] =0 ; 

/*printf(”\n  sigmaO  =  %10.5e  ”, sigmaO);*/ 

/* 

printf(”\n  \n  a0[0]  =  %10.5e  ”,pstate->a0[0] ) ; 
printf(”\n  al[0]  =  %10.5e  ” ,pstate->al [0] ) ; 
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printf(''\n  bl[0]  =  %10.5e  ",pstate->bl[0] )  ; 

*/ 

fprintf  (f3, ''\n  \n  a0[0]  =  %10.5e  \r'',pstate->a0[0]); 
fprintf  (f3, ''\n  al[0]  =  %10.5e  \r",pstate->al[0]); 
fprintf (f 3, "Xn  bl[0]  =  %10.5e  \r",pstate->bl[0]); 

/*scanf  (''%d" , &T1)  ; */  /*  Pause  */ 

)  /*  end  if  pstate->N%2==l  */ 

/*  Generate  the  Filter  Coefficients  for  the  Second  Order  Sections  */ 

s  1  ainbda=  1  ambda  *  1  ambda ; 

f or ( i=l ; i<=pstate->r ; i++ ) 

{ 

/*printf (''\n  i=  %2d  '',i);*/ 
if (pstate~>N%2==l)  mu=i;  else  inu=i-0.5; 
for  (in=0,dl=0;m<=4  ;m++) 

dl  +=  rcpow(~1.0,in)  *rcpow(q,m*  (m+l) )  *sin(  (2*in+l)  *PI*inu/pstate->N) 
for  (in=l ,  d2=0  ;in<=5  ;m++) 

d2  +=  rcpow(-l.  0,in)  *rcpow(q,m*m)  *cos(2*m*PI*mu/pstate->N)  ; 
0MEGA[i]=*2*sqrt(sqrt(q)  )*dl/(l+2*d2)  ; 

V [ i ] =sqrt ( ( l-k*OMEGA [ i ] *OMEGA [ i ] ) * ( 1-OMEGA [ i ] *OMEGA [ i ] /k) ) ; 

AO [ i ] =1/ (OMEGA [ i ] *OMEGA [ i ] ) ; 
tmp=l+ssigiaaO/AO[i] ; 

BO[i]  =  (ssiginaO*V[i]*V[i]+W*W/AO[i]  )/(tmp*tinp)  ; 

B1  [  i]=2*siginaO*V[  ij/tmp; 

tmp  =  4+2*Bl[i]/lambda+B0[i]/slanibda; 

pstate->aO [ i ] =  ( 4+AO [ i ] /si ambda) /tmp ; 

pstate->al [ i ] =  -2  * ( 4 -AO [ i ] /slambda) /tmp ; 

pstate->a2 [i]=  pstate->aO [ i] ; 

pstate->bl[i]=  -2* (4-B0[i]/slambda)/tmp; 

pstate->b2 [ i]=  (4-2*Bl [ i]/lambda+BO [i]/slambda)/tmp; 

pstate->s [ i ] =0 ; 

pstate->s_oldl [ i ] =0 ; 

/*  Print  Out  Filter  Coefficients  */ 

/* 

printfC'Xn  \n  A0[%d]  =  %10.5e  ”,i,A0[i]); 
printfC'Xn  B0[%d]  =  %10.5e  '•,i,B0[i]); 
printf^"\n  Bl[%d]  =  %10.5e  ••,i,Bl[i]); 
printf("\n  a0[%d]  =  %10.5e  " , i,pstate->aO[ i] ) ; 
printf('’\n  al[%d]  =  %10.5e  ” ,  i  ,pstate->al  [  i] )  ; 
printf("\n  a2[%d]  =  %10.5e  ” , i,pstate->a2 [ i] ) ; 
printf(''\n  bl[%d]  =  %10.5e  ,  i,pstate->bl[i] )  ; 

printf(''\n  b2[%d]  =  %10.5e  ",  i,pstate->b2[i] )  ; 

*/ 
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fprintf (f3, ”\n  \n  aO[%d]  =  %10.5e  \r",i,pstate->aO[i]); 
fprintf  (f3 , ''\n  al[%d]  =  %10.5e  \r'' , i,pstate->al[ i] )  ; 
fprintf  (f3 , ''\n  a2[%d]  =  %10.5e  \r'' ,  i,pstate->a2  [i] )  ; 
fprintf (f 3, ”\n  bl[%d]  =  %10.5e  \r'',i,pstate->bl[i]); 
fprintf  (f 3 , ''\n  b2[%d]  =  %10.5e  \r'' , i,pstate->b2 [i] )  ; 


/*scanf  (''%d”,&Tl)  ;*/  /*  Pause  */ 


/*  Calculate  the  Gain  Ho  */ 

for  ( i=l ,  tinp=l .  0 ;  i<=pstate->r ;  i++) 
trap  *=  BO[i]/AO[i]; 

if (pstate->N%2==l) 

pstate->Ho=siginaO*tmp ; 

else 

pstate->Ho=tmp*exp(-ln(10. 0) *Ap/20) ; 

/*  Print  out  Ho  */ 

/*printf('’\n  \n  Ho  =  %10.5f  '•,pstate->Ho)  ;*/ 
fprintf  (f 3 , ''\n  \n  Ho  =  %10.5f  \r",pstate->Ho)  ; 

/*scanf  (''%d'',&Tl)  ;*/  /*  Pause  */ 

}  /*  end  if  option  ==  2  */ 

/*  Error  Declarations  */ 
if  (option  ==  1)  { 

printf(''\n  OPTION  ERROR**)  ; 
return ( 2 ) ; } 

fprintf  (f 4,  "%3d  \n  \r** , pstate->N)  ;  /*  print  filter  delay  in  file  */ 

if (no_output_fifos 0  !=  1)  return (2) ; 
if (no_input_f ifos ( )  !=  1)  return (3 ) ; 

fclose(fl) ; 
f close (f2) ; 
f close (f3) ; 
fclose(f4) ; 

pstate->time=0 ; 

pstate->finp=fopen(*'rcinp.dat*', **w*')  ;  /*  filter  input  data  file  */ 

pstate->fout=fopen("rcout.dat’', *'w*')  ;  /*  filter  output  data  file  */ 

)/*  end  if  (pstate==NULL)  */ 


if (length_output_fifo(0)  ==  inaxlength_output_fifo(0) )  return(O); 
if (length_input_f ifo(O)  <1)  return(O); 

while (length_input_fifo(0)  >0) 
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{ 

if (length_output_fifo(0)  ==  inaxlength_outpuc_fifo(0) )  return (0) ; 
get(0,&x) ; 

/*  Write  Filter  Input  Data  to  File  */ 
if  (pstate->tiine<4*L) 

fprintf  (pstate“>f  inp, ''\n  %f,  %f\r'',  (float)  pstate~>tiine,x)  ; 
if (pstate->time=*4*L-l)  fclose (pstate->finp) ; 

/*  Generate  Filter  Output  */ 

X  *=  pstate->Ho; 

if (pstate->N%2==l) 

{ 

s_old [ 0 ] =pstate->s [ 0 ] ; 

pstate->s [ 0 ] =x-pstate->bl [ 0 ] *s_old [ 0 ] ; 

x=pstate“>aO [ 0 ] *pstate->s [ 0 ] +pstate->al [ 0 ] *s_old [ 0 ] ; 

} 

if (pstate->N>l) 

for ( i=l ; i<=pstate->r ; i++ ) 

{ 

s_old2 [ i ] =pstate->s_oldl [ i ] ; 
pstate->s_oldl [ i ] *pstate->s [ i ] ; 

pstate->s [ i ] =x-pstate->bl [ i ] *pstate->s_oldl [ i ] -pstate->b2 [ i ] *s_old2 [ i ] 
x=pstate->aO [ i ] *pstate->s ( i ] +pstate->al [ i ] *pstate->s_oldl [ i ] 
+pstate->a2 [ i ] *s_old2 [ i ] ; 

) 

put (0,x) ; 

/*  Write  Filter  Output  Data  to  File  */ 
if  (pstate->tiine<4*L) 

fprintf  (pstate->fout,  ”\n  %f,  %f\r",  (float)  pstate->tiine,x)  ; 
if (pstate->time==4*L-l)  fclose (pstate->fout) ; 

pstate~>tiine++ ; 

} 

return (0)  ; 

) 

Z*******************************************************************/ 

double  rcpow ( x , i ) 
double  x; 
int  i; 

{ 

int  n; 
double  p; 
if(i==0) 
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p=1.0; 

else 

for (n=l,p=l;n<=i;n++) 
p  *=  x; 
return (p) ; 

} 


/********************  RCFIR.C  ***********************/ 

/*  Function  rclpf()  */ 

/*  File  Parameter  Version  of  FIR  Filter  */ 

/*  Receiver  Filter  Application  */ 

#  include  ''type.h” 

#  include  "star.h” 

#  include  <stdio.h> 

#  include  <mth.h> 

#  define  PI  3.1415926535 

#  define  L  40 

typedef  struct  { 
int  none; 

}  PARAM, *PARAMPTR; 
typedef  struct  { 

double  inp[321],  h[321],  Ho; 
int  NN; 
int  time; 

FILE  *finp,  *fout; 

)  STATE, *STATEPTR; 

rclpf (pparam,size,pstate,pstar) 
int  size; 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 

{ 

SAMPLE  input , output ; 
double  RCBESSELO  ; 

double  tmp , tmpl , tmp2 , f s , Ap , Aa , fp , f a , wa , wc , wp , d , dl , d2 , D , alpha , Aahat 
float  temp; 
int  i,N,n,T,Tl; 
char  *calloc() ; 

FILE  *fopen(),  *fl,  *f2,  *f3,  *f4; 
if  (pstate  ==  NULL  )  { 

pstate=( STATEPTR)  alloc_state__var(l,sizeof  (STATE) )  ; 

f l=f open ( "rcvf Itrl . td^" , "r” ) ; 
f2=fopen(''rcvfltr2 .  tdt" ,  ”r”)  ; 

fscanf  (fl, ''%f  ” , &temp)  ;  /*  Read  Option  Type  */ 

T=( int) temp; 

f3=fopen(”rcfilt.dat" , ”w”) ; 
f  4=f open  ( ’’rcdelay .  dat” ,  ”w" )  ; 

if  (T  ==  2)  { 

/*  Option  2  */ 

/*  Read  in  Filter  Specifications  */ 

fscanf  (f 2, ''%lf'',&fs)  ; 
fscanf  (f2,''%lf'',&fp)  ; 
fscanf  (f2,''%lf'',&fa)  ; 
fscanf  (f2,''%lf'',&Ap)  ; 
fscanf  (f 2, '•%lf",&Aa)  ; 
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printf(''\n  \n  FIR  RECEIVER  FILTER  \n''); 
fprintf  (f3,''\n  FIR  RECEIVER  FILTER  \n  \r'')  ; 
printf("\n  USER  FILTER  SPECIFICATIONS"); 
printf("\n  Sampling  Frequency  =  %10.2f  Hz  ",fs); 
printf("\n  Passband  Edge  Frequency  =  %10.2f  Hz  ",fp); 
printf("\n  Stopband  Edge  Frequency  =  %10.2f  Hz  ",fa); 
printf("\n  Maximum  Passband  Attenuation  =  %10.2f  dB  ",Ap); 
printf("\n  Minimum  Stopband  Attenuation  =  %10.2f  dB  ",Aa); 

fprintf (f 3, "\n  USER  FILTER  SPECIFICATIONS  \r"); 
fprintf (f 3 , "\n  Sampling  Frequency  =  %10.2f  Hz  \r",fs); 
fprintf (f3 , "\n  Passband  Edge  Frequency  =  %10.2f  Hz  \r",fp); 
fprintf (f 3 , "\n  Stopband  Edge  Frequency  =  %10.2f  Hz  \r",fa); 
fprintf (f 3, "\n  Maximum  Passband  Attenuation  =  %10.2f  dB  \r",Ap); 
fprintf (f 3, "\n  Minimum  Stopband  Attenuation  =  %10.2f  dB  \r",Aa) ; 

printf("\n  \n  FILTER  DESIGN  RESULTS"); 
fprintf (f 3, "\n  \n  FILTER  DESIGN  RESULTS  \r"); 

/*  Calculating  Filter  Parameters  from  Specifications  */ 

wp=2*PI*fp/fs; 
wa=2*PI*fa/fs; 
wc=(wa+wp) /2 ; 
dl=exp(-ln(10.0) *Aa/20) ; 
d=exp ( In ( 10 . 0 ) *Ap/2  0 ) ; 
d2=(d-l)/(d+l) ; 
if(dl<d2)  d*dl;  else  d=d2; 

Aahat=  -  20*logl0(d); 
pstate->Ho=l/ (1+d) ; 

printf("\n  Actual  Stopband  Attenuation  =  %10.2f  dB  ",Aahat); 
fprintf (f 3, "\n  Actual  Stopband  Attenuation  =  %10.2f  dB  \r",Aahat); 

/*printf("\n  Gain  Adjustment  =  %10.2f  ",pstate->Ho) ;*/ 

if (Aahat<=21)  { 
alpha=0 ; 

D=0.9222; } 

else  if  (Aahat>50) 

alpha=0. 1102*(Aahat-8.7) ; 

else 

alpha=0. 5842 *exp( 0.4 *ln(Aahat-21) ) +0. 07886* (Aahat-21) ; 

if (Aahat>21) 

D= (Aahat-7 . 95) /14 .36; 

tmp=l+D*2*PI/ (wa-wp) ; 

for(N=l;N<1000;N  +=  2)  if(N>=tmp)  break; 

printf("\n  Filter  Order  =  %3d  ",N); 
fprintf (f 3, "\n  Filter  order  =  %3d  \r",N); 
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/*printf("\n  alpha  =  %10.2f  ", alpha);*/ 
/*printf("\n  D  =  %lOf  ",D);*/ 


if  (N>=320)  { 

printf("\n  FILTER  ORDER  OUT  OF  RANGE"); 
return ( 3 ) ; } 

/*scanf ("%d",&Tl) ;*/  /*  Pause  */ 

/*  Calculating  the  Filter  Coefficients  */ 
pstate->NN= ( N- 1 ) / 2 ; 

/*  pstate->inp  =  (double  *)  calloc(2*pstate->NN+l,sizeof (double) ) ; 
pstate->h  =  (double  *)  calloc(2*pstate->NN+l, sizeof (double) ) ; 

*/ 

/*printf ("\n  \n  Filter  Impulse  Response:  \n") ;*/ 
fprintf (f3 , "\n  \n  Filter  Impulse  Response:  \n  \r") ; 

f or (n=  -pstate->NN ; n<=pstate->NN ; n++ ) 

{ 

if (n==0) 
tmp=wc/PI ; 
else 

tmp=sin(n*wc)/ (PI*n) ; 


tmpl=(n*l. 0)/pstate->NN; 

tmp2=RCBESSEL(alpha*sqrt (l-tmpl*tmpl) )/RCBESSEL( alpha) ; 
pstate->h [ n+pstate->NN ] =tmp*tmp2 ; 

/*printf("\n  h[%d]  =  %10.5e  ",n+pstate“>NN,pstate->h[n+pstate->NN] ) ;*/ 
fprintf (f 3, "\n  h[%d]  =  %10.5e  \r",n+pstate->NN,pstate->h[n+pstate->NN] ) ; 

} 

/*scanf ("%d",&Tl) ;*/  /*  Pause  */ 

)  /*  end  if  (T  «  2),  Option  2  */ 


if  (T  ==  1)  { 

/*  Option  1  -  Read  in  the  Filter  Order  and  Sampling  Frequency  */ 

fscanf (fl,"%f",&temp) ; 

N*(int) temp; 
fscanf (fl,"%lf",&fs) ; 
fscanf (fl,"%lf",&fp) ; 

printf("\n  \n  FIR  RECEIVER  FILTER  \n") ; 
printf("\n  USER  FILTER  SPECIFICATIONS"); 
printf("\n  Filter  Order  =  %3d  ",N) ; 
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printf(''\n  Sampling  Frequency  *  %10.2f  Hz  ",fs); 
printf(''\n  Cutoff  Frequency  =  %10.2f  Hz'',fp); 
fprintf  (f3,  "Xn  USER  FILTER  SPECIFICATIONS  \r''); 
fprintf  (f3,''\n  Filter  Order  =  %3d  \r'',N)  ; 
fprintf  (f3, ''\n  Sampling  Frequency  =  %10.2f  Hz  \r'',fs); 
fprintf  (f 3,  "\n  Cutoff  Frequency  =  %10.2f  Hz  \r'',fp); 

if  (N>=320)  { 

printfC'Xn  FILTER  ORDER  OUT  OF  RTUIGE”)  ; 
return ( 3 ) ; ) 

/*  Read  in  the  Filter  Coefficients  */ 
pstate“>NN=(N-l)/2 ; 

/*  pstate->inp  =  (double  *)  calloc(2*pstate->NN+l, sizeof (double) ) ; 
pstate->h  =  (double  *)  calloc(2*pstate->NN+l, sizeof (double) ) ; 

*/ 

/*printf (''\n  \n  Filter  Impulse  Response:  \n'');*/ 
fprintf (f 3 , "\n  \n  Filter  Impulse  Response:  \n  \r”) ; 


f or ( n*  -pstate->NN ; n<=pstate->NN ; n++ ) 

{ 

fscanf  (fl,  ''%lf'',  &pstate->h[n+pstate->NN] )  ; 

/*printf(”\n  h(%d]  =  %10.5e  '',n+pstate->NN,pstate->h[n+pstate->NN] )  ;*/ 
fprintf (f 3 , "\n  h(%d]  ®  %10.5e  \r”,n+pstate->NN,pstate->h[n+pstate->NN] ) 

)  /*  end  for  */ 

pstate->Ho=l ; 

/*scanf  (''%d'',&Tl)  ;*/  /*  Pause  */ 

)  /*  end  if  (T  ==  1)  -  Option  1  */ 


for ( i=2*pstate->NN-l ; i>=0 ; i — )  pstate->inp [i]=0; 

fprintf (f4, "%3d  \n  \r” ,pstate->NN) ;  /*print  filter  delay  in  rcdelay.dat*/ 

if (no_output_fifos()  !=  1)  return (2 ) ; 
if (no_input_fifos()  1=  1)  return (3 ) ; 

pstate->time=0 ; 

pstate->finp=fopen("rcinp.dat'' ,  ”w”)  ;  /*  filter  input  data  file  */ 

pstate->fout=fopen(''rcout.dat*' ,  ”w”)  ;  /*  filter  output  data  file  */ 

fclose(fl) ; 
fclose(f2)  ; 
f close (f 3) ; 
fclose(f4)  ; 

)  /*  end  if  (pstate  ==  NULL  */ 
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if (length_output_fifo(0)  ==  maxlength_output_fifo(0) )  return ( 0) ; 
if (length_input_fifo(0)  <1)  return(O) ; 


while (length_input_fifo(0)  >0) 

{ 

if (length_output_fifo(0)  ==  inaxlength_output_fifo(0) )  return ( 0) ; 
get (0, fiinput) ; 

/*  Write  Filter  Input  Data  to  File  */ 
if  (pstate->tiiae<4*L) 

fprintf  (pstate->finp,  ”\n  %f,  %f\r'',  (float)pstate->time,  input)  ; 
if (pstate->time==4*L-l)  f close (pstate->finp) ; 

/*  Perform  Convolution  to  Generate  Filter  Output  */ 

input  *=  pstate->Ho; 

for(i=2*pstate->NN-l;i>=0;i — )  pstate->inp[i+l]=pstate->inp[i] ; 
pstate->inp [ 0 ] =input ; 
output=0 ; 

f or ( n=  -pstate->NN ; n<=pstate->NN ; n++ ) 

output  +=  pstate->h[n+pstate->NN] *pstate->inp[n+pstate->NN] ; 
put (0, output) ; 

/*  Write  Filter  Output  Data  to  File  */ 
if (pstate->time<4*L) 

fprintf  (pstate->fout/'\n  %f,  %f\r'',  (float)pstate->time, output)  ; 
if (pstate->time==4*L-l)  f close (pstate->f out) ; 


pstate->time++ ; 

} 

return (0)  ; 

} 

/**************************************************************************** 

double  RCBESSEL(x) 
double  x; 

{ 

double  I0,t,t2; 

t=x/3.75; 

t2=t*t; 

if(x>=0  &&  x<=3.75) 

I0=l+t2* (3 . 5156229+t2* (3 . 0899424+t2* (1. 2067492+t2* (0 . 2659732 
+t2*(0.0360768+t2*0. 0045813) ) ) ) ) ; 
else  if(x>3.75) 

10=*(exp(x)/sqrt(x)  )*  (0. 39894228+ (0. 01328592+ (0. 00225319 

+(-0.00157565+ (0.00916281+ (-0.02057706 

+ (0.02635537+ (-0. 01647633+0. 00392377/t)/t)/t)/t)/t)/t)/t)/t) ; 
return (10) ; 

} 
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/It********************  RSCOD.C  **********************/ 

/*****  (15,9)  Reed-Solonon  Encoder  *****/ 

/*  Function  rscod()  */ 

# include  <stdio.h> 

# include  "type.h” 

# include  "star.h” 

Idefine  TT  6 
fdefine  N  15 

fdefine  K  9 

#define  CNT  pstate->cnt 
#define  W  pstate->w 

Idefine  G  pstate->g 

Idefine  B  pstate->b 

Idefine  H  pstate->h 

Idefine  F  pstate->f 

typedef  struct  { 
int  non; 

} 

PARAM,  »PARAMPTR; 
typedef  struct  { 

unsigned  char  b[TT] ,g[TT+l] ,cnt,h[N] , f [N+1] , w; 

} 

STATE,  *STATEPTR; 

rscod  (pparain,size,pstate,pstar) 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 
int  size; 

{ 

SAMPLE  bit; 
int  i , j , symbol ; 

if  (pstate  ==  NULL)  { 

pstate  =  (STATEPTR)  alloc_state_var (1, sizeof (STATE) ) ; 
if  (no_input_f ifos (  )  !=1  | |  no_output_f ifos (  )  !=2) 
return (3) ; 

/***  H[  ]  and  F[  ]  compute  the  power  and  log  in  GF(16)  ********/ 

H[0]=l; 

for(i=0;i<4 ;i++)  H[i+l]=2*H[i] ; 
for(i=4;i<N;i++)  H[i]=H[i-3] *H[i-4] ; 

for(j*l; j<N+l; j++)  { 

for(i=0;i<N;i++)  ( 

if(H[i]==j)  F[j]=i; 

) 

} 

F[0]=0; 

CNT=0 ; 

W=0; 
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/***  g[  ]  are  the  coefficients  of  the  generating  polynomial  ****/ 

G[0]=H[6] ; 

G[1]=H[9]; 

G[2]=H[6] ; 

G[3]=H[4]; 

G[4]=H[14] ; 

G[5]=H[10] ; 

G[6]=H[0] ; 

} 

/* 

if (length_output_f ifo(O)  !=  length_output_fifo(l) )  return (7 ) ; 

*/. 

if  (Iength_output_fifo(0)==maxlength__output_fifo(0) )  return(O)  ; 
if  (length_output_fifo(l)==maxlength_output_fifo(l) )  return(O) ; 

while (length_input_f if o(0)  >0  | j  CNT>=K  ) 

{ 

/* 

printf  (''\ninp  rscod0=%4d  CNT=%4d'' , length_input  fifo(O)  , CNT)  ; 

*/ 

if (Iength_output_fifo(0)==maxlength_output_fifo(0) )  return(O) ; 

/*. 

if ( length_output_f ifo (1) ==maxlength_output  f if o ( 1) )  return ( 0 ) ; 

*/ 

if(CNT==0)  for(i=0;i<TT;i++)  B[i]*0; 

/******************************************************************/ 
if(CNT<K)  /**  information  bits  **/ 

{ 

symbol=0 ; 

for (i=0;i<4 ;i++) 

{ 

get(0,&bit)  ; 
put (1, bit) ; 

symbol  *=  ( (int)bit)<<i; 

} 

W=(symbol)  “B[TT-1]  ; 

) 

else  /**  parity  bits  **/ 

{ 

symbol=B[TT-l] ; 

W=0; 

} 

for ( i=TT-l ; i>0 ; i — ) 

B[i]=B[i-l]  '  (W!=0)*(H[  (F[G[i]  ]+F[W])%N])  ; 

B[0]  =  (W!=0)  *(H[  (F[G[0]  ]+F[W])%N])  ; 

Z*********************************************************************/ 

for ( i=0 ; i<4 ; i++) 

{ 

bit=(symbol>>i) &01; 
put (0, bit) ; 
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} 

CNT=(CNT+1) %N; 


/* 

printf  (''\nout  rscod0=%4d'' 
printf  (''\nout  rscodl=%4d'' 
*/ 

return  (0)  ; 


} 


length_output_fifo(0) ) ; 
length_output_fifo(l) ) ; 
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/*************  RSDEC.C  ***************/ 

/****  (15,9)  Reed-Soloxnon  Decoder  *****/ 

/*  Function  rsdec()  */ 

# include  <stdio.h> 

# include  "type.h” 

# include  "star.h” 

#define  TT  6 

tdefine  N  15 

fdefine  K  9 

Idefine  H  pstate->h 

#define  F  pstate->f 

typedef  struct  { 
int  non; 

} 

PARAM,  *PARAMPTR; 
typedef  struct  { 

unsigned  char  h[N],f[N+l]; 

} 

STATE,  *STATEPTR; 

rsdec  (pparam,si2e,pstate,pstar) 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 
int  size; 

{ 

SAMPLE  bit; 

unsigned  char  e[N+l]  ,E[N+1]  ,S[TT+1)  ,sig[TT+l]  ,degR,degQ,a,b,  tein,Q[TT+l] ; 
unsigned  char  R[TT+1]  ,inu[TT+l] ,  lain[TT+l]  ,REC[N]  ,TEM[TT+1]  ; 
int  i, j , L, CL, TH, symbol ; 

if  (pstate  ==  NULL)  { 

pstate  =  (STATEPTR)  alloc_state_var (1, sizeof (STATE) ) ; 
if  (no_input_fifos (  )  !=1  | |  no_output_fifos (  )  !=1)  return (3) ; 

/***  H[  ]  and  F[  ]  compute  the  power  and  log  in  GF(16)  ********/ 

H[0]=l; 

for(i=0;i<4;i++)  H[i+l]=2*H[i] ; 
for(i=4;i<N;i++)  H[i]=H[i-3] *H[i-4] ; 

for ( j=l; j<N+l; j++)  { 

for(i=0;i<N;i++)  { 

if(H[i]==j)  F[j]=i; 


) 

} 

F[0]=99; 

} 


if  (Iength_output_fifo(0)==maxlength_output_fifo(0) )  return(O) ; 
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while (length_input_fifo(0)  >0  ) 

{ 

if  (Iength_output_fifo(0)==inaxlength_output_fifo(0) )  return(O)  ; 

/it*****************************************************************/ 
for( j=0; j<N; j++) 

{ 

syinbol=0  ; 

for(i=0;i<4;i++)  {get(0,&bit)  ;  symbol  *=  ( (int) bit)  «i ; } 

REC[ j ]=(char) symbol ; 

} 

/***************  Syndrome  calculation  ********************************/ 

for ( j=0; j<=TT; j++)  S[j]=0; 
for(i=0; i<N;i++) 

{ 

for(j= 5;j<TT;j++)  S[ j ]=REC[i] ‘ ( (S[ j ]  !=  0) * (H[ (6-j+F[S[ j ] ] ) %N] ) ) ; 

} 

/* 

for(j=0;  j<TT;  j++)  p^-intf(''\n  %4d%4d%4d'',  j  ,S[  j  ]  ,F[S[  j  ]  ] )  ; 

*/ 

for ( j=0 ; j<TT; j++) 

{ 

S[j]=0; 

for(i=0;i<N;i++)  S[j]  *=  ((REC[N-l-i]  !=  0) * (H[ (i* ( j+1) +F[REC[N-l-i] ] ) %N] ) ) 
} 

/* 

for(j=0; j<TT; j++)  printf("\n  %4d%4d%4d", j ,S[ j ] ,Frs[ j ] ] ) ; 

*/ 

/*********  Modified  Euclid  Algorithm  ********************************/ 
for(j=0; j<=TT; j++)  {R[j]=0;  lam[j]=0;  mu[j]=0;  E[ j ]=S [TT-j ] ;  } 
for(j=0;j<=TT;j++)  {R[j]=0;  lam[j]=0;  mu[j]=0;  E[j+l]=S[j];  Q[j]=0;} 

for( j=0; j<TT; j++)  Q[ j ]=S[TT-l-j ] ; 

R[TT]=1; 
mu[0]=l; 
degR=TT ; 
degQ=TT ; 
i=l; 

TH=TT/2 ; 
while (i<=TT) 

{ 

j  =degR ; 

while(R[ j ]==0)  degR=  — j; 
if(degR>TT)  degR=0; 
j=degQ; 

while (Q[ j ]==0)  degQ=  — • 
if(degQ>TT)  degQ=0; 

L=degR-degQ ; 

CL=L; 

if(L<0)  CL=  -L; 
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/* 

printf (''\n\n  i=%3d'',i); 

printf(''\n  degR=%3d  degQ=%3d  L=%3d  ••,degR,degQ,L)  ; 

*/ 

/* 

for ( j=0; j<=TT; j++) 

{ 

printf C'Xn  Q%3d  %3d  %3d  ”, j ,Q[j] ,F[Q[j] ]) ; 
printfC  R%3d  %3d  ” ,  R[  j  ] ,  F[R[  j  ]  ] )  ; 

} 

*/ 

if(degR<TH  ||  degQ<TH) 

{ 

if(degR<TH)  {  for  ( j=0 ;  j<=TT;  j++)  sig[  j  ]=lain[  j  ]  ;  } 
else  {  for( j=0; j<=TT; j++)  sig[ j ]=mu[ j ] ;  } 

i=TT+l; 

} 

else 

{ 

if (degR<degQ) 

{ 

for ( j=0 ; j<=TT; j++) 

{ 

TEM[j]=R[j] ; 

R[j]*Q[j]; 

Q[j]=TEMtj]; 

) 

f or ( j  =0 ; j  <«TT ; j  ++ ) 

{ 

TEM[j]=lain[j]; 
lain[j]=inu[j] ; 
mu [ j ] =TEM [ j ] ; 

) 

tem=degR ; 
degR=degQ ; 
degQ=tem ; 

} 

if (Q[degQ]==0) 

{ 

degQ —  ; 
if (degQ<TH) 

{ 

for  ( j  =  =0;  j<=TT;  j++)  sig[  j  ]=mu[  j  ] ; 
i=TT+l; 

} 

} 

else 

{ 

degR —  ; 

/*  compute  R  lam  ******* v^*********************************************/ 
a=R[degP+l ] ; 
b=Q [ degQ ] ; 

/* 

printf  C'Xn  a=%3d  b=%3d'' ,  F[a] ,  F[b] )  ; 
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*/ 

for ( j=0; j<=TT; j++) 

{ 

TEM[ j ]=( j>=CL) *Q[ j“CL] ; 

R[j]=(R[j] l=0)*(bl=0)*CH[(F[b]+F[R[j]])%N]) *(TEM[j]!=0) 
*(a!=0)*(H[ (F[a]+F[TEM[j] ])%N]) ; 

TEM [ j ]  =  ( j  >=CL) *mu [ j -CL] ; 

lam[j]  =  (lam[j]  l=0)*(b!=0)*(H[  (F[b]+F[laiti[  j  ]  ] )  %N] )  *  (TEM[j]  1=0) 
*(a!=0)*(H[ (F[a]+F[TEM[j] ])%N])  ; 

) 


if (degR<TH) 

{ 

for ( j=0; j<=TT; j++)  sig[ j ]=lam[ j ] ; 
i=TT+l; 

) 

} 

/* 

for ( j=0; j<=TT; j++) 

{ 

printf(''\n  Q%3d  %3d  ••,Q[  j  ]  ,F[Q[  j  ]  ] )  ; 
printfC  R%3d  %3d  ”  ,R[  j  ] ,  F[R[  j  ]  ] )  ; 
printf(''  lam%3d  %3d  ,  lain[  j  ] ,  F[lani[  j  ]  ] )  ; 

printf(''  mu%3d  %3d  ”  ,inu[  j  ] ,  F[mut  j  ]  ] )  ; 

) 

*/ 

) 

i++; 

} 

/**************  Error  locator  polynomial  *****************************/ 
degR=TT ; 
j  =degR ; 

while(sig[ j ]==0)  degR=  — j; 
if (degR>TT)  degR=0 ; 


tem=sig[degR] ; 
f or ( j  =0 ; j  <=TT ; j  ++ ) 

{ 

sig[j]=(sig[j] !=0)*(H[(N-F[tem]+F[sig[j]])%N]) ; 

/* 

printf(''\n  sig%3d  %3d  %3d  ”/ j /Sig[  j  ]  ,F[sig[  j  ]  ] )  ; 

*/ 

} 


for ( j=TT-l ; j<=N-2 ; j++) 


{ 

E[j+2]=0; 

for ( i=0 ; i<degR ; i++) 


{ 

tem=sig[degR-i-l] ; 

E[j+2]  *=  (tem!=0) *(E[ j+l-i] i=0) *{H[ (F[tem]+F[E[ j+l-i] ] ) %N] ) ; 

) 

} 

E[0]-E[N] ; 
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for ( j=0 ; j<=N; j++) 

/* 

printf(”\n  E%3d  %3d  %3d  " , j ,E[ j ] ,F[E[ j ] ] ) ; 

*/ 

y * ************ ***ij^vers6  'trcinsf onn  ********************************/ 
for(j=0; j<=N; j++)  e[j]=0; 
f or ( i=0 ; i<N ; i++ ) 

{ 

for(j=0;j<N;j++)  e[ j ]=E[N-i-l] * ( (e[ j ]  !=  0) * (H[ ( j+l+F[e[ j ] ] ) %N] ) ) ; 

} 

for(j=0; j<N; j++) 

{ 

e[j]=0; 

for(i=0;i<N;i+-r)  e[j]  *=  ((E[i]  !=0)  *  (H[  ( (N*N-i*  ( j ) ) +F[E  [  i]  ] )  %N] ) )  ; 
} 

for(j=0; j<K; j++) 

{ 

syinbcl=REC[  j  ]  ‘e[N-l-j  ] ; 

for(i=0;i<4;i++)  {bit=(syinbol»i) &01;  put(0,bit);} 

} 

) 

return  (0) ; 

} 
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/****************  SIN.C  ****************/ 

/*  Function  gen()  */ 

/*  Generates  a  Sinuisoidal  Signal  of  Given  Frequency  */ 

# include  "type.h” 

# include  "star.h” 
finclude  <stdio.h> 

# include  <mth.h> 

#define  PI  3.1415926535 

typedef  struct  { 

int  sainple_stp; 
int  seed; 

}  PARAM,  *PARAMPTR; 

typedef  struct  { 

int  sainple_no; 
int  sainple_stop; 
float  tmp; 

}  STATE,  *STATEPTR; 

gen (pparam, size , pstate , pstar) 

PARAMPTR  pparam; 
int  size; 

STATEPTR  pstate; 

STARPTR  pstar; 

{ 

SAMPLE  x; 

FILE  *fopen(),  *fl; 
float  fs,  fc; 

if (pstate  ==  NULL)  { 

pstate  =  (STATEPTR)  alloc_state_var (1 , sizeof (STATE) ) ; 
pstate->sample_no  =0; 

if (size  ==  0)  pstate->saraple_stop  =  100; 
else  if (size  ==  sizeof (PARAM) ) 
pstate->sample_stop  =  pparam->sample_stp ; 
else  return (1) ; 

if (no_output_fifos()  !=  1)  return (2 ) ; 
if (no_input_fifos()  !=  0)  return (3 ) ; 

fl=fopen ( "source. tdt" , "r”) ; 
fscanf (fl,"%f",&fs) ; 
fscanf (fl,"%f",&fc) ; 
fclose(fl) ; 

printf("\n  Sampling  Frequency  =  %10.2f  Hz",fs); 
printf("\n  Sinuisoidal  Frequency  =  %10.2f  Hz",fc); 

pstate->tmp  =  (2*PI*fc) /fs ; 

) 

if (pstate->sample_no  >=  ppararo->sample_stp)  return ( 99 ) ; 

if (length_output_f ifo(O)  ==  maxlength_output_fifo(0) )  return (0) ; 
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while (length_output_fifo (0)  <inaxlength_output_f if 0(0) ) 
{ 

X  =  sin(pstate->tinp*pstate->sample_no)  ; 
/*printf(''\n  %10d  %10.4f'',pstate->sample_no,x)  ;*/ 
put(0,x)  ; 

pstate->saniple_no++ ; 

} 

return (0) ; 

} 
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/*******************  SINK.C  *********************/ 

/*  Function  sink()  */ 

# include  "type.h” 

# include  ''star.h” 

# include  <stdio.h> 

typedef  struct  { 

int  sample_stp; 
int  seed; 

}  PARAM,  *PARAMPTR; 
typedef  struct  { 

float  time;  /*  holds  current  time,  which  is  printed  */ 
float  time_scale; 

}  STATE,  *STATEPTR; 

sink(pparam, size,pstate,pstar) 

PARAMPTR  pparam; 

int  size;  /*sizeof  parameter  storage  */ 

STATEPTR  pstate; 

STARPTR  pstar; 

{ 

SAMPLE  x; 

int  i,j,c; 
float  disp; 

if (pstate  ==  NULL)  { 

pstate  =  (STATEPTR)  alloc_state_var(l,sizeof (STATE) ) ; 
if (no_input_fifos()  !=  1)  return ( 1) ; 
if (no_output_fifos()  !=  0)  return (2 ) ; 
pstate->time_scale  =  1.0; 

if(size<=0)  return (2 04 ) ; 

pstate->time  =  0.0; 

} 

while(length_input_fifo(0) >0) 

{ 

get(0,&x) ; 

/*printf ("\n%10d  %10.3f”, (int) pstate“>time, x) ;*/ 

pstate->time  +=  1; 

} 

return (0) ; 

} 
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/*******************  TBPDEM.C  ******************/ 

/*  Function  bpsk_dein()  */ 

/*  Time  Domain  Version  */ 

linclude  <stdio.h> 

# include  "type.h'* 
linclude  ''star.h” 

Idefine  L  40 

typedef  struct  { 
int  non; 

}  PARAM,  *PARAMPTR; 

typedef  struct  { 
int  none; 

}  STATE,  *STATEPTR; 

bpsk_dem  (pparam, si2e,pstate,pstar) 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 
int  size; 

{ 

SAMPLE  input , output ; 
float  svim; 
int  i; 

if  (pstate  ==  NULL)  { 

pstate  =  (STATEPTR)  alloc_state_var ( 1 , sizeof (STATE) ) ; 
if  (no_input_fifos(  )  1=1  | |  no_output_fifos (  )  1=1) 

} 

if  (Iength_output_fifo(0)==maxlength_output_fifo(0) )  return (0) ; 

while (length_input_f if 0(0)  >  0) 

{ 

if (Iength_output_fifo(0)==maxlength_output_fifo(0) )  return(O) 
sum=0; 

for (i=0;i<L;i++) 

{ 

get (0,& input) ; 

/*sum  +=  input;*/ 
if(i==(L/2  -  1))  sum  =  input; 

) 

if(sum>0)  output=l;  else  output=  -1; 
put(0, output) ; 

} 

return  ( 0 )  ; 

} 


return (3)  ; 
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/*******************  TBPMOD.C  *******************/ 

/*  Function  bpsk_inod()  */ 

/*  Time  Domain  Version  */ 

# include  <stdio.h> 

# include  <mth.h> 

# include  "type.h” 

# include  "star.h" 

#define  L  40 

typedef  struct  { 
int  non; 

}  PARAM,  *PARAMPTR; 

typedef  struct  { 
int  none; 

}  STATE,  *STATEPTR; 

bpsk_mod  (pparam, size,pstate,pstar) 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 
int  size; 

{ 

SAMPLE  input , output ; 
int  i; 

if  (pstate  «  NULL)  { 

pstate  =  (STATEPTR)  alloc_state_var ( 1 , sizeof (STATE) ) ; 
if  (no_input_fifos(  )  !=1  ||  no_output_fifos (  )  !=1)  return (3) ; 

) 

if  (Iength_output_fifo(0)==maxlength_output_fifo(0) )  return(O) ; 

while (length_input_f if o(0)  >  0) 

{ 

if (Iength_output_fifo(0)==maxlength_output_fifo(0) )  return(O) ; 
get (0, &input) ; 

/*output= input/ sqrt ( ( float) L) ; */ 
output = input ; 

for(i=0;i<L;i++)  put (0, output) ; 

} 

return  (0)  ; 

} 
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/It****************  TXBUT.C  *************11******/ 

/*  Function  txlpf()  */ 

/*  File  Parameter  Version  of  Butterworth  Filter  */ 

/*  Transmitter  Filter  Application  */ 

#  include  "type.h" 

#  include  "star.h" 

#  include  <stdio.h> 

#  include  <mth.h> 

#  define  PI  3.1415926535 

#  define  L  40 

typedef  struct  { 
int  none; 

)  PARAM,*PARAMPTR; 
typedef  struct  { 

double  a0[ 21],  al[21],  a2[21],  bl[21],  b2[21],  s[21], 
int  N; 
int  time; 

FILE  *finp,  *fout; 

}  STATE, *STATEPTR; 

txlpf (pparam, size,pstate,pstar) 
int  size; 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 

{ 

SAMPLE  x; 
float  temp; 

double  tmp, Ap, Aa, fc, fs, fp, fa,wa,wc,wp; 
double  dl,d2,  gamma [21],  s_old[21],  s_old2[21]; 
int  i,k,option,Tl; 
char  *calloc() ; 

FILE  *fopen(),  *fl,  *f2,  *f3,  *f4; 
if  (pstate  ==  NULL  )  { 

ps tat e= (STATEPTR)  alloc_state_var (1, sizeof (STATE) ) ; 
/*  Filter  Specifications  */ 


f  l=f open  ( "chlf  Itrl .  tdt” ,  ''r'' )  ; 
f 2=f open ( "chlf ltr2 . tdt” , ”r" ) ; 

fscanf (f 1, ”%f” , &temp) ;  /*  Read  Option  Type  */ 

opt ion= ( int) temp ; 
f3=fopen(”txfilt.dat” , ”w”) ; 
f 4=f open ( ” txdelay . dat” , ”w” ) ; 

if  (option  ==  2)  ( 

/*  Option  2  */ 

/*  Read  in  Filter  Specifications  */ 

fscanf (f 2, ”%lf",&fs) ; 
fscanf (f 2, ”%lf”,&fp) ; 


fscanf  ; 

fscanf  (f2,''%lf'',&Ap)  ; 
fscanf  (f 2,  ••%lf'',&Aa)  ; 

printf(''\n  \n  BUTTERWORTH  TRANSMITTER  FILTER  \n'')  ; 
printf(''\n  USER  FILTER  SPECIFICATIONS”); 
printf(”\n  Sampling  Frequency  =  %10.2f  Hz  ”,fs); 
printf(”\n  Passband  Edge  Frequency  =  %10.2f  Hz  ”,fp); 
printf(”\n  Stopband  Edge  Frequency  =  %10.2f  Hz  ”,fa); 
printf(”\n  Maximum  Passband  Attenuation  =  %10.2f  dB  ”,Ap) ; 
printf(”\n  Minimum  Stopband  Attenuation  =  %10.2f  dB  ”,Aa); 

fprintf (f3, "\n  BUTTERWORTH  TRANSMITTER  FILTER  \n  \r”); 
fprintf (f3, ”\n  USER  FILTER  SPECIFICATIONS  \r”); 
fprintf (f 3 , ”\n  Sampling  Frequency  =  %10.2f  Hz  \r”,fs); 
fprintf (f 3 , ”\n  Passband  Edge  Frequency  =  %10.2f  Hz  \r”,fp); 
fprintf (f 3, ”\n  Stopband  Edge  Frequency  =  %10.2f  Hz  \r”,fa); 
fprintf (f 3 , ”\n  Maximum  Passband  Attenuation  =  %10.2f  dB  \r”,Ap); 
fprintf (f 3,” \n  Minimum  Stopband  Attenuation  =  %10.2f  dB  \r”,Aa); 

printf(”\n  \n  FILTER  DESIGN  RESULTS”); 
fprintf (f 3, ”\n  \n  FILTER  DESIGN  RESULTS  \r”) ; 

/*  Calculating  Filter  Parameters  from  Specifications  */ 

tmp=PI*fp/fs;  wp=2*sin(tmp)/cos(tmp) ; 
tmp=PI*fa/fs;  wa*2*sin(tmp)/cos(tmp) ; 

dl=exp(ln(10.0) *Ap/10) ; 
d2=exp(ln(10. 0) *Aa/10) ; 
tmp=ln( (dl-l)/(d2-l) )/(2*ln(wp/wa) ) ; 

for ( pstate->N=l ; pstate->N< 100 ; pstate->N++ )  i f ( pstate->N>=tmp )  break ; 
wc=wa/exp( (1/ (2 , 0*pstate->N) )*ln(d2-l) ) ; 

printf(”\n  Order  =  %2d” ,pstate->N) ; 
fprintf (f 3 , ”\n  Order  =  %2d  \r”,pstate->N) ; 

/*printf(”\n  wc  =  %10.5f  rad  ”,wc) ;*/ 


}  /*  end  if  option  ==  2  */ 


if  (option  ==  1)  { 

/*  Option  1  V 

/*  Read  in  Filter  Specifications  */ 

fscanf (fl, ”%f” , Stemp) ; 
pstate->N= ( int ) temp ; 
fscanf (fl,”%lf”,&fs) ; 
fscanf (fl,”%lf”,&fc) ; 

printf(”\n  \n  BUTTERWORTH  TRANSMITTER  FILTER  \n”); 
printf (”\n  USER  FILTER  SPECIFICATIONS”) ; 
printf(”\n  Order  =  %2d” ,pstate->N) ; 
printf(”\n  Sampling  Frequency  =  %10.2f  Hz  ”,fs); 
printf(”\n  3dB  Cutoff  Frequency  *  %10.2f  Hz  ”,fc); 
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fprintf  (f3, ''\n  BUTTERWORTH  TRANSMITTER  FILTER  \n  \r''); 
fprintf (f3,''\n  USER  FILTER  SPECIFICATIONS  \r''); 
fprintf  (f 3 , ''\n  Order  =  %2d  \r’' ,pstate->N)  ; 
fprintf  (f3 , ''\n  Sampling  Frequency  =  %10.2f  Hz  \r",fs); 
fprintf  (f3 , ''\n  3dB  Cutoff  Frequency  =  %10.2f  Hz  \r”,fc); 

/*  Calculating  Filter  Parameters  from  Specifications  */ 

tmp=PI*fc/fs;  wc=2*sin(tmp)/cos(tmp) ; 

/*printf  (''\n  wc  =  %10.5f  rad  ",wc)  ;*/ 

)  /*  end  if  option  ==  1  */ 

if  (pstate->N  >=  40)  ( 

printf(''\n  FILTER  ORDER  OUT  OF  RANGE”); 
return ( 3 ) ; } 

/*scanf (”%d”,&Tl) ;*/  /*  Pause  */ 

/* 

pstate->a0= (double  *)  calloc(l+pstate->N/2,sizeof (double) ) ; 
pstate->al= (double  *)  calloc(l+pstate->N/2,sizeof (double) ) ; 
pstate->a2= (double  *)  calloc(l+pstate->N/2,sizeof (double) ) ; 
pstate->bl= (double  *)  calloc(l+pstate->N/2,sizeof (double) ) ; 
pstate->b2= (double  *)  calloc(l+pstate->N/2,sizeof (double) ) ; 
pstate->s= (double  *)  calloc(l+pstate->N/2,sizeof (double) ) ; 
pstate->s_oldl= (double  *)  calloc(l+pstate->N/2,sizeof (double) ) ; 
s_old2= (double  *)  calloc(l+pstate->N/2 ,sizeof (double) ) ; 
s_old=(double  *)  calloc(l+pstate->N/2,sizeof (double) ) ; 
gamma={double  *)  calloc(l+pstate->N/2,sizeof (double) ) ; 

*/ 

/*  Calculating  Transfer  Function  Coefficients  */ 

if  (pstate->N%2“l)  /*  Filter  Order  N  is  odd  */ 

{ 

f or (k=pstate->N+l ;k<=l . 5*pstate->N+i ;k++) 
gamma [k-pstate->N-l]=wc*cos( (k-1) *PI/pstate->N) ; 

)  /*  end  odd  N  */ 

else  /*  Filter  Order  N  is  even  */ 

{ 

for ( k=pstate->N+ 1 ; k<= ( 3  *pstate->N+ 1 ) / 2 ; k++ ) 

gamma [k-pstate->N]=wc*cos( (2*k-l) *PI/ (2*pstate->N) ) ; 

)  /*  end  even  N  */ 


/*printf(”\n  \n  Filter  Coefficients:”);*/ 
fprintf (f 3, ”\n  \n  Filter  Coefficients;  \r”) ; 

/*  Generate  the  Filter  Coefficients  for  the  First  Order  Section  */ 

if (pstate->N%2=*l)  { 
pstate->a0[0]=  wc/(2+wc); 
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pstate“>al [ 0 ] =  pstate->aO [ 0 ] ; 
pstate->bl[0]=  -(2-wc)/(2+wc) ; 
pstate->s [ 0 ] =0 ; 

/* 

printf(''\n  \n  a0[0]  =  %10.5e  '',pstate->a0[0] )  ; 
printf(''\n  al[0]  *  %10.5e  '•  ,pstate->al[0] )  ; 
printf(‘'\n  bl[0]  =  %10.5e  '•  ,pstate->bl[0] )  ; 

*/ 

fprintf (f3,”\n  \n  a0[0]  =  %10.5e  \r”,pstate->a0[0]); 
fprintf  (f3, ’'\n  al[0]  =  %10.5e  \r”,pstate->al[0] )  ; 
fprintf (f3,''\n  bl[0]  =  %10.5e  \r'',pstate->bl[0]); 

/*scanf  (''%d'',SiTl)  ;*/  /*  Pause  */ 

}  /*  end  if  pstate->N%2==l  */ 

/*  Generate  the  Filter  Coefficients  for  the  Second  Order  Sections  */ 

for ( i=l ; i<=pstate->N/2 ; i++) 

{ 

tmp  =  4-4*gainina[i]+wc*wc; 
pstate->aO[i]=  wc*wc/tmp; 
pstate->al [ i ] =  2  *pstate->a0 [ i ] ; 
pstate->a2 [i]=  pstate->a0 [ i] ; 
pstate->bl[i]=  -2* (4-wc*wc)/tmp; 
pstate->b2  [  i  ]  =  ( 4+4  *ga]iuna  [  i  ]  +wc*wc)  /tmp ; 
pstate->s [ i ] =0 ; 
pstate->s_oldl [ i ] =0 ; 

/* 

printf("\n  \n  a0[%d]  =  %10.5e  ”, i,pstate->aO[i] ) ; 
printf(”\n  al[%d]  =  %10.5e  ”, i,pstate->al[i] ) ; 
printf(”\n  a2[%d]  =  %10.5e  ” , i,pstate->a2 [i] ) ; 
printf(”\n  bl[%d]  =  %10.5e  ”,i,pstate->bl[i] ) ; 
printf(”\n  b2[%d]  =  %10.5e  " ,  i , pstate>'>b2 [ i ] )  ; 

*/ 

fprintf (f 3, ”\n  \n  a0[%d]  =  %10.5e  \r”,i,pstate->aO[i]) ; 
fprintf (f3 , ”\n  al[%d]  =  %10.5e  \r” , i,pstate->al[ i] ) ; 
fprintf (f 3, ”\n  a2[%d]  =  %10.5e  \r”,i,pstate->a2[i]) ; 
fprintf (f 3, ”\n  bl[%d]  =  %10.5e  \r” , i,pstate->bl [ i] ) ; 
fprintf (f 3,” \n  b2[%d]  =  %10.5e  \r”,i,pstate->b2[i]); 

/*scanf (”%d”, &T1) ;*/  /*  Pause  */ 

) 

fprintf (f4 , ”%3d  \n  \r” ,pstate->N) ;  /*  print  filter  delay  in  file  */ 

if (no_output_fifos()  I-  1)  return (2 ) ; 
if (no_input_fifos()  !=  1)  return (3 ) ; 

pstate->time=0 ; 

pstate“>finp*fopen(”txinp.dat”,”w”) ;  /*  filter  input  data  file  */ 

pstate->fout=fopen(”txout.dat”, ”w”) ;  /*  filter  output  data  file  */ 


91 


fclose(fl)  ; 

£close(f2)  ; 
f close (f 3)  ; 
fclose(f4)  ; 

}  /*  end  if  (pstate  ==  NULL)  */ 

if (length_output_fifo(0)  ==  inaxlength_output_fifo(0) )  return (0) ; 
if (length_input_fifo(0)  <1)  return(O); 

while (length_input_fifo(0)  >0) 

{ 

if (length_output_fifo(0)  ==  maxlength_output_fifo(0) )  return ( 0) ; 
get(0,&x) ; 

/*  Write  Filter  Input  Data  to  File  */ 
if (pstate->time<4*L) 

fprintf  (pstate->finp, ''\n  %f,  %f\r”,  (float)pstate->tiine,x)  ; 
if  (pstate->tinie==4*L-l)  fclose (pstate->f inp)  ; 

/*  Generate  Filter  Output  */ 

if (pstate->N%2==l) 

{ 

s_old [ 0 ] =pstate->s [ 0 ] ; 

pstate->s [ 0 ] =x-pstate->bl [ 0 ] *s_old [ 0 ] ; 

x=pstate->aO [ 0 ] *pstate->s [ 0 ] +pstate->al [ 0 ] *s_old [ 0 ] ; 

) 

if (pstate->N>l) 

for ( i=l ; i<=pstate->N/2 ; i++) 

{ 

s_old2 [ i ] =pstate->s_oldl [ i ] ; 
pstate->s_oldl [ i ] =pstate->s [ i ] ; 

pstate->s  [  i  ]  ==x-pstate->bl  [  i  ]  *pstate->s_oldl  [  i  ]  -pstate->b2  [  i  ]  *s_old2  [  i  ]  ; 
x=pstate->aO [ i ] *pstate->s [ i ] +pstate->al [ i ] *pstate->s_oldl [ i ] 

+pstate->a2 [ i ] *s_old2 [ i ] ; 

) 

put(0,x) ; 

/*  Write  Filter  Output  Data  to  File  */ 
if  (pstate->tiine<4*L) 

fprintf  (pstate->f out , ''\n  %f,  %f\r'‘ ,  (float) pstate->tiine, x)  ; 
if (pstate“>time==4*L-l)  fclose (pstate->fout) ; 


pstate->tiine++ ; 
} 

return (0)  ; 

} 
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y  ***  TXCHEB  .  C  *******************/ 

/*  Function  txlpf()  */ 

/*  File  Parameter  Version  of  Chebychev  Filter  */ 

/*  Transmitter  Filter  Application  */ 


#  include  "type.h” 

#  include  "star.h'' 

#  include  <stdio.h> 

#  include  <mth.h> 

#  define  PI  3.1415926535 

#  define  L  40 

typedef  struct  { 
int  none; 

}  PARAM,*PARAMPTR; 
typedef  struct  { 

double  a0[21],  al[21],  a2[21],  bl[21],  b2[21],  s[21],  s_oldl[21]; 
double  Ho; 
int  N; 
int  time; 

FILE  *finp,  *fout; 

}  STATE, *STATEPTR; 

txlpf (pparam, si2e,pstate,pstar) 
int  size; 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 

{ 

SAMPLE  x; 
float  temp; 

double  eps,tmp, Ap, Aa, fc, fs, fp, fa,wa,wp; 
double  dl,d2,  s_old[21],  s_old2[21]; 

double  sigma[83],  omega[83],  pO,  Re_p[42],  Iin_p[42],  eta[;2],  gamma[42] 
int  i,k,option,Tl; 
char  *calloc(); 

FILE  *fopen(j,  *fl,  *f2,  *f3,  *f4; 
if  (pstate  ==  NULL  )  { 

pstate= (STATEPTR)  alloc_state_var ( 1 , sizeof (STmTE) ) ; 

/*  Filter  Specifications  */ 

f  l=f open  ( "chlf  Itrl .  tdt" ,  ''r« )  ; 
f 2=f open ( "chi f ltr2 .tdt", ”r") ; 

fscanf (fl,”%f”,&temp) ;  /*  Read  Option  Type  */ 

option=(int) temp; 
f3=fopen(”txf ilt.dat" , ”w”) ; 
f  4=f open ( ” txdeiay . dat ” , ”w” ) ; 


if  (option  ==  2)  { 

/*  Option  2  */ 

/*  Read  in  Filter  Specifications  */ 
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fscanf  (f2,”%lf'',&fs)  ; 
fscanf  ; 

fscanf  (f2,''%lf'',&fa)  ; 
fscanf ( f2 , "%lf " , &Ap) ; 
fscanf  (f 2," %lf'',&Aa)  ; 

printf(''\n  \n  CHEBYCHEV  TRANSMITTER  FILTER  \n''); 
printf(''\n  USER  FILTER  SPECIFICATIONS”); 
printf(”\n  Sampling  Frequency  =  %10.2f  Hz  ”,fs); 
printf(”\n  Passband  Edge  Frequency  =  %10.2f  Hz  ”,fp); 
printf(”\n  Stopband  Edge  Frequency  =  %10.2f  Hz  ",fa); 
printf(”\n  Maximum  Passband  Attenuation  =  %10.2f  dB  ”,Ap); 
printf(”\n  Minimum  Stopband  Attenuation  =  %10.2f  dB  ",Aa); 

fprintf (f3,”\n  CHEBYCHEV  TRANSMITTER  FILTER  \n  \r”); 
fprintf (f3, ”\n  USER  FILTER  SPECIFICATIONS  \r”); 
fprintf (f3 , ”\n  Sampling  Frequency  =  %10.2f  Hz  \r”,fs); 
fprintf (f 3 , ”\n  Passband  Edge  Frequency  =  %10.2f  Hz  \r”,fp); 
fprintf (f3 , ”\n  Stopband  Edge  Frequency  =  %10.2f  Hz  \r”,fa); 
fprintf (f3 , ”\n  Maximum  Passband  Attenuation  =  %10.2f  dB  \r”,Ap); 
fprintf (f 3, ”\n  Minimum  Stopband  Attenuation  =  %10.2f  dB  \r”,Aa); 

printf(”\n  \n  FILTER  DESIGN  RESULTS”); 
fprintf (f 3, ”\n  \n  FILTER  DESIGN  RESULTS  \r”) ; 


/*  Calculating  Filter  Parameters  from  Specifications  */ 

tmp=PI*fp/fs;  wp=2*sin(tmp)/cos(tmp) ; 
tmp=PI*fa/fs;  wa=2*sin(tmp)/cos(tmp) ; 
eps=sqrt(exp(ln(10.0) *Ap/10)-l) ; 
dl=sqrt (exp(ln(10. 0) *Aa/10) -l)/eps; 
d2=wa/wp ; 

tmp=ln(dl+sqrt (dl*dl-l) )/ln(d2+sqrt (d2*d2-l) ) ; 

for(pstate->N=l;pstate->N<100;pstate->N++)  if (pstate->N>=tmp)  break; 

printf(”\n  Order  =  %2d”,pstate->N); 
fprintf (f 3 , ”\n  Order  =  %2d  \r”,pstate->N) ; 

/*printf(”\n  wp  =  %l0.5f  rad  ”,wp) ; 
printf(”\n  epsilon  =  %10.5f  ”,eps);*/ 


}  /*  end  if  option  ==  2  */ 


if  (option  ==  1)  { 

/*  Option  1  */ 

/*  Read  in  Filter  Specifications  */ 

fscanf (fl, ”%f” , Stemp) ; 
pstate“>N= ( int) temp ; 
fscanf (fl,”%lf”,&fs) ; 
fscanf (fl,”%lf”,&fp) ; 

printf(”\n  \n  CHEBYCHEV  TRANSMITTER  FILTER  \n”) ; 


94 


printf(''\n  USER  FILTER  SPECIFICATIONS”); 
printf(”\n  Order  =  %2d”,pstate->N) ; 
printf(”\n  Sampling  Frequency  =  %10.2f  Hz  ”,fs); 
printf(”\n  3dB  Cutoff  Frequency  =  %10.2f  Hz  ”,fp); 

fprintf (f3,”\n  CHEBYCHEV  TRANSMITTER  FILTER  \n  \r"); 
fprintf (f3, ”\n  USER  FILTER  SPECIFICATIONS  \r”); 
fprintf (f 3, ”\n  Order  =  %2d  \r”,pstate“>N); 
fprintf (f 3 , ”\n  Sampling  Frequency  =  %10.2f  Hz  \r”,fs); 
fprintf (f 3 , ”\n  3dB  Cutoff  Frequency  =  %10.2f  Hz  \r”,fp); 

/*  Calculating  Filter  Parameters  from  Specifications  */ 

tmp=PI*fp/fs;  wp=2*sin(tmp)/cos(tmp) ; 

Ap=3 . 0 ; 

eps=sqrt(exp(ln(10.0) *Ap/10)-l) ; 

/*printf(”\n  wp  =  %10.5f  rad  ”,wp) ; 
printf{”\n  epsilon  =  %10.5f  ”,eps);*/ 


}  /*  end  if  option  ==  1  */ 

/*scanf (”%d”,&Tl) ;*/  /*  Pause  */ 

if  (pstate->N  >=  40)  { 

printf("\n  FILTER  ORDER  OUT  OF  RANGE”); 
return ( 3 ) ; } 


/* 

pstate->a0= (double  *)  calloc(l+pstate->N/2,sizeof (double) ) ; 
pstate->al= (double  *)  calloc(l+pstate->N/2,sizeof (double) ) ; 
pstate->a2= (double  *)  calloc(l+pstate->N/2,sizeof (double) ) ; 
pstate->bl= (double  *)  calloc(l+pstate->N/2,sizeof (double) ) ; 
pstate->b2= (double  *)  calloc(l+pstate->N/2,sizeof (double) ) ; 
pstate->s= (double  *)  calloc(l+pstate->N/2,sizeof (double) ) ; 
pstate->s_oldl= (double  *)  calloc(l+pstate->N/2 , sizeof (double) ) ; 
s_old2= (double  *)  calloc (l+pstate->N/2 , sizeof (double) ) ; 
s_old=(double  *)  calloc (l+pstate->N/2, sizeof (double) ) ; 
sigma=(double  *)  calloc (l+2*pstate->N, sizeof (double) ) ; 
omega=(double  *)  calloc (l+2*pstate->N, sizeof (double) ) ; 

Re_p=(double  *)  calloc (l+pstate->N, sizeof (double) ) ; 

Im_p=(double  *)  calloc (l+pstate->N, sizeof (double) ) ; 
eta=(double  *)  calloc (l+pstate->N, sizeof (double) ) ; 
gamma=(double  *)  calloc (l+pstate->N, sizeof (double) ) ; 

*/ 

/*  Calculating  Transfer  Function  Coefficients  */ 
tmp=l/eps; 

f or (k=l ; k<=2  *pstate->N ; k++ ) 

{ 

sigma[k]= 

-sinh(ln(tmp+sqrt (tmp*tmp+l) )/pstate->N) *sin( (2*k-l) *PI/ (2*pstate->N) ) 
omega [k]= 

cosh(ln(tmp+sqrt (tmp*tmp+l) )/pstate->N) *cos ( (2*k-l) *PI/ (2*pstate->N) ) ; 
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/*printf ("Xn  sigina(%2d)  =  %10.5e,  omega(%2d)  =  %10.5e  '^k, sig¬ 
ma  [k]  ,k, omega [k] ) ;*/ 

) 

/♦printf (''\n  wp  =  %l0.5f  rad  ",wp);*/ 
i=l; 

f or ( k=l ; k<=2 *pstate->N ; k++ )  if ( s igma [ k] <0 ) 

{Re_p[i]=sigma[k] ; 

Im_p [ i ] =omega [ k] ; 
gamma [ i ] =wp*Re_p [ i ] ; 

eta [ i ] =wp*wp* (Re_p [ i ] *Re_p [ i ] +Im_p  [ i ] *Im_p [ i ] ) ; 
i++ ; } 

/*for (i=l ; i<=pstate->N/2 ; i++)  { 

printf("\n  Re_p(%2d)  =  %10.5e,  Im__p(%2d)  =  %10.5e  ** ,  i,Re_p[ i] ,  i ,  Im_p[i  j ) 
printf(''\n  gamma (%2d)  =  %10.5e,  eta(%2d)  =  %10.5e  ”,  i,gamma[i] ,  i,eta[i] ) 
} 

*/ 

if (pstate->N%2==l) 

{p0=sigma[ (pstate->N+l)/2 ] ; 

/*printf("\n  for  odd  N,  p[0]  =  %10.5e  ”,p0) ;*/ 

pstate->Ho=  -pO ; } 
else 

pstate->Ho=  exp(-ln(10.0) *Ap/20) ; 

for (i=l;i<=pstate->N/2 ;i++) 

pstate->Ho  *=  Re_p[i]  *Re_p[i]+Im__p[i]*Im_p[i] ; 


/*scanf ("%d”,&Tl) ;*/  /*  Pause  */ 


/*printf(”\n  \n  Filter  Coefficients;”);*/ 
fprintf (f3 , ”\n  \n  Filter  Coefficients:  \r”) ; 

/*  Generate  the  Filter  Coefficients  for  the  First  Order  Section  */ 

if (pstate->N%2==l)  { 
pstate->a0[0]=  wp/ (2-wp*p0) ; 
pstate->al [ 0 ] =  pstate->a0 [ 0 ] ; 
pstate->bl[0]=  -(2+wp*p0)/ (2-wp*p0) ; 
pstate->s [ 0 ] =0 ; 

/* 

printf(”\n  \n  a0[0]  =  %10.5e  ”,pstate->a0[0] ) ; 
printf(”\n  al[0]  =  %10.5e  ” ,pstate->al[0] ) ; 
printf(”\n  bl[0]  =  %10.5e  ”,pstate->bl[0] ) ; 

*/ 

fprintf ff 3, ”\n  \n  a0[0]  =  %10.5e  \r”,pstate->a0[0] ) ; 
fprintf (f 3,” \n  al[0]  =  %10.5e  \r”,pstate->al[0] ) ; 
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fprintf  (f3,''\n  bl[0]  =  %10.5e  \r’',pstate->bl[0]); 

/*scanf  (•'%(!",  &T1)  ;*/  /*  Pause  */ 

)  /*  end  if  pstate->N%2==l  */ 

/*  Generate  the  Filter  Coefficients  for  the  Second  Order  Sections  */ 

for ( i=l ; i<=pstate->N/2 ; i++) 

{ 

/*printf("\n  gainina(%2d)  =  %10.5e,  eta(%2d)  =  %10.5e  ",  i, gamma [ i] ,  i, eta [ i] )  ;*/ 
tmp  =  4-4*gamma[i]+eta[i] ; 

/*printf("\  tmp  =  %10.5e  ",tmp);*/ 
pstate->aO[i]=  wp*wp/tmp; 
pstate->al[i]=  2*pstate->a0 [ i] ; 
pstate->a2  [i]=  pstate-->aO [ i ]  ; 
pstat*»-'>bl[i]=  -2*  (4-eta[i]  )/tmp; 
pstate->b2 [ i ] =  ( 4+4  *gamma [ i ] +eta [ i ] ) /tmp ; 
pstate->s [ i ] =0 ; 
pstate->s_oldl [ i] =0 ; 

/* 

printf("\n  \n  a0[%d]  =  %10.5e  ", i,pstate->aO[i] ) ; 
printf("\n  al[%d]  =  %10.5e  ",i,pstate->al[i] ) ; 
printf("\n  a2[%d]  =  %10.5e  " , i , pstate->a2 [ i ] ) ; 
printf("\n  bl[%d]  =  %10.5e  " , i,pstate->bl[i] ) ; 
printf("\n  b2[%d]  =  %10.5e  " , i , pstate->b2 [ i ] ) ; 

*/ 

fprintf (f 3, "\n  \n  a0[%d]  =  %10.5e  \r", i,pstate->aO[i] ) ; 
fprintf (f 3, "\n  al[%d]  =  %10.5e  \r",i,pstate“>al[i] ) ; 
fprintf (f 3," \n  a2[%d]  =  %10.5e  \r", i,pstate->a2 [i] ) ; 
fprintf (f 3, "\n  bl[%d]  =  %10.5e  \r",i,pstate->bl[i]) ; 
fprintf (f 3 , "\n  b2[%d]  =  %10.5e  \r", i,pstate->b2 [i] ) ; 


/*scanf ("%d",&Tl) ;*/  /*  Pause  */ 

) 


/*printf("\n  Ho  =  %10.5f  " , pstate->Ho) ; */ 
fprintf (f 3 , "\n  \n  Ho  =  %10.5f  \r",pstate->Ho) ; 


fprintf (f4, "%3d  \n  \r" ,pstate->N) ;  /*  print  filter  delay  in  file  */ 

if (no_output_fifos()  !=  1)  return (2 ) ; 
if (no_input_fifos()  !=  1)  return (3) ; 

pstate->time=0 ; 

pstate->finp=fopen("txinp.dat" , "w") ;  /*  filter  input  data  file  */ 

pstate->fout=fopen("txout.dat" , "w") ;  /*  filter  output  data  file  */ 

fclose(fl) ; 
fclose(f2) ; 
f close (f 3)  ; 
fclose(f4)  ; 


97 


}  /*  end  if  (pstate  ==  NULL)  */ 


if (length_output_fifo(0)  ==  inaxlength_output_fifo(0) )  return ( 0) ; 
if (length_input_fifo(0)  <1)  return(O); 

while (length_input_f if o(0)  >0) 

{ 

if (length_output_fifo(0)  ==  maxlength_output_fifo(0) )  return ( 0) ; 
get(0,&x) ; 

/*  Write  Filter  Input  Data  to  File  */ 
if  (pstate->tiine<4*L) 

fprintf  (pstate->finp,  ”\n  %f,  %f\r'',  (float)pstate->time,x)  ; 
if  (pstate->tiine==4*L-l)  fclose (pstate->f inp)  ; 

/*  Generate  Filter  Output  */ 

X  *=  pstate->Ho; 

if (pstate->N%2==l) 

{ 

s_old [ 0 ] =pstate->s [ 0 ] ; 

pstate”>s [ 0 ] =x-pstate->bl [ 0 ] *s_old [ 0 ] ; 

x=pstate->aO [ 0 ] *pstate->s [ 0 ] +pstate->al [ 0 ] *s_old [ 0 ] ; 

} 

if (pstate->N>l) 

for ( i=l ; i<=pstate->N/2 ; i++) 

{ 

s_old2 [ i ] =pstate->s_oldl [ i ] ; 
pstate->s_oldl [ i ] =pstate->s [ i ] ; 

pstate->s  [  i ]  =x-pstate->bl  [  i ]  *pstate->s_oldl  [  i  ]  -pstate-'>b2  [  i  ]  *s_old2  [  i  ] 
x=pstate->aO [ i ] *pstate->s [ i ] +pstate->al [ i ] *pstate->s_oldl [ i ] 
+pstate->a2 [ i ] *s_old2 [ i ] ; 

} 

put(0,x) ; 

/*  Write  Filter  Output  Data  to  File  */ 
if (pstate->time<4*L) 

fprintf  (pstate->fout, ''\n  %f,  %f\r",  (float)  pstate->time,x)  ; 
if  (pstate->tiiae==4*L-l)  fclose (pstate->fout)  ; 

pstate->tiine++  ; 

} 

return (0) ; 

) 
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TXELL.C  A*******************/ 

/*  Function  txipf()  */ 

/*  File  Parameter  Version  of  Elliptic  Filter  */ 

/*  Transmitter  Filter  Application  */ 

#  include  "type.h” 

#  include  "star.h” 

#  include  <stdio.h> 

#  include  <mth.h> 

#  define  PI  3.1415926535 

#  define  L  40 

typedef  struct  { 
int  none; 

}  PARAM,*PARAMPTR; 
typedef  struct  { 

double  a0[21],  al[21],  a2[21],  bl[21],  b2[21],  s[21],  s_oidl[21 
double  Ho; 
int  r,N; 
int  time; 

FILE  *finp,  *fout; 

}  STATE, *STATEPTR; 

txlpf (pparam, size,pstate,pstar) 
int  size; 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 

{ 

SAMPLE  x; 
float  temp; 

double  tmp, Ap, Aa, fs, fp, fa,wa,wp,Aahat ; 

double  dl,d2,  s_old[21],  s_old2[21]; 

double  A0[21],  B0[21],  Bl[21],  V[21],  0MEGA[21] ; 

double  W, k,kp, qO, q4 , q, D, LAMBDA, lambda, slambda, sigmaO , ssigmaO ,mu; 

int  i,m, option, Tl; 

char  *calloc() ; 

double  txpow() ; 

FILE  *fopen(),  *fl,  *f2,  *f3,  *f4; 


if  (pstate  ==  NULL  )  { 

pstate=( STATEPTR)  alloc_state_var (1, sizeof (STATE) ) ; 

/*  Filter  Specifications  */ 

fl=fopen(''chlfltrl.  tdt” ,  "r”)  ; 
f2=fopen(’'chlfltr2.tdt'',"r")  ; 

fscanf  (fl, ''%f'' ,  Stemp)  ;  /*  Read  Option  Type  */ 

option* ( int) temp ; 
f3=fopen(''txfilt.dat'' ,  "w”)  ; 
f 4=f open ( "txdelay . dat” , "w" ) ; 


if  (option  --2)  { 


99 


/*  Option  2  */ 

/*  Read  in  Filter  Specifications  */ 


fscanf  (f2,''%lf'',&fs)  ; 
fscanf (f2,"%lf",&fp) ; 
fscanf  (f 2, ''%lf'',&fa)  ; 
fscanf  ( f 2 ,  ''%lf  ” ,  &Ap)  ; 
fscanf (f 2 , "%lf" , &Aa) ; 

printf  ("\n  \n  ELLIPTIC  TRANSMITTER  FILTER  \n'')  ; 
printf(”\n  USER  FILTER  SPECIFICATIONS*'); 
printf ("\n  Sampling  Frequency  =  %10.2f  Hz  ",fs); 
printf ("\n  Passband  Edge  Frequency  =  %10.2f  Hz  ",fp); 
printf ("\n  Stopband  Edge  Frequency  =  %10.2f  Hz  ",fa); 
printf ("\n  Maximum  Passband  Attenuation  =  %10.2f  dB  ",Ap); 
printf("\n  Minimum  Stopband  Attenuation  ==  %10.2f  dB  ",Aa); 

fprintf (f3, "\n  ELLIPTIC  TRANSMITTER  FILTER  \n  \r"); 
fprintf (f3, "\n  USER  FILTER  SPECIFICATIONS  \r"); 
fprintf (f3 , "\n  Sampling  Frequency  =  %10.2f  Hz  \r",fs); 
fprintf (f 3 , "\n  Passband  Edge  Frequency  =  %10.2f  Hz  \r",fp); 
fprintf (f 3 , "\n  Stopband  Edge  Frequency  =  %10.2f  Hz  \r",fa); 
fprintf (f 3 , "\n  Maximum  Passband  Attenuation  =  %10.2f  dB  \r",Ap) ; 
fprintf (f 3, "\n  Minimum  Stopband  Attenuation  =  %10.2f  dB  \r",Aa); 

printf ("\n  \n  FILTER  DESIGN  RESULTS*'); 
fprintf (f 3, "\n  \n  FILTER  DESIGN  RESULTS  \r") ; 


/*  Calculating  Filter  Parameters  from  Specifications  */ 

tmp=PI*fp/fs;  wp=2*sin(tmp)/cos(tmp) ; 
tmp=PI*fa/fs;  wa=2*sin(tmp)/cos(tmp) ; 
k=wp/wa ; 

/*printf("\n  Filter  Selectivity  k  =  %10.5f  ",k) ;*/ 
kp=sqrt(l-k*k) ; 

q0=0.5*(l-sqrt(kp) )/(l+sqrt(kp) ) ; 
q4=q0*q0*q0*q0 ; 

q=q0+2*q0*q4+15*q0*q4*q4+150*q0*q4*q4*q4 ; 
dl=exp(ln(10. 0) *Ap/10) ; 
d2=exp(ln(10. 0) *Aa/10) ; 

D*(d2-l)/(dl-l) ; 
tmp=ln(16*D)/ln(l/q) ; 

for ( pstate->N=l ; pstate->N< 100; pstate->N++ )  i f ( pstate->N>=tmp)  break ; 

printf ("\n  Filter  Order  N  =  %2d  ",pstate->N) ; 
fprintf (f 3, "\n  Order  =  %2d  \r",pstate->N) ; 

if  (pstate->N  >=40)  { 

printf ("\n  FILTER  ORDER  OUT  OF  RANGE"); 
return ( 3 ) ; ) 

Aahat=10.0*logl0( (dl-1)/ (16.0*txpow(q,pstate->N) )+l) ; 
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printf(''\n  Actual  Stopband  Attenuation  =  %10.2f  dB  ",Aahat); 
fprintf  (f3 , ''\n  Actual  Stopband  Attenuation  =  %10.2f  dB  \r”,Aahat); 

pstate->r=pstate->N/2 ; 
lainbda=sgrt  (k)  /wp ; 
dl=exp(ln(10.0) *Ap/20) ; 

LAMBDA=(0.5/pstate-->N)  *ln ( (dl+1)/ (dl-1) )  ; 
for  (in=0 ,  dl=0 ;  m<=4  ;m++) 

dl  +=  txpow(-l. 0,in)  *txpow(q,m* (m+l) )  *sinh(  (2*m+l)  *LAMBDA)  ; 
for (m=l , d2=0 ;m<=5 ;m++) 

d2  +=  txpow(-l.  0,in)  *txpow(q,itt*in)  *cosh(2*in*LAMBDA)  ; 

sigTnaO=2*sqrt  (sqrt  (q) )  *dl/  (l+2*d2)  ; 
if(siginaO  <  0)  sigmaO  =  -sigmaO; 
ssiginaO=sigmaO*siginaO ; 

W=sqrt  ( ( l+k*ssigniaO )  *  ( l+ssigmaO/k) )  ; 

/*scanf  (••%d'',&Tl)  ;  V  /*  Pause  */ 

/* 

pstate->a0= (double  *)  calloc(l+pstate->r, sizeof (double) ) ; 
pstate->al= (double  *)  calloc(l+pstate->r, sizeof (double) ) ; 
pstate->a2= (double  *)  calloc(l+pstate->r, sizeof (double) ) ; 
pstate->bl= (double  *)  calloc(l+pstate->r, sizeof (double) ) ; 
pstate->b2= (double  *)  calloc (l+pstate->r, sizeof (double) ) ; 
pstate->s* (double  *)  calloc (l+pstate->r, sizeof (double) ) ; 
pstate“>s_oldl= (double  *)  calloc (l+pstate->r, sizeof (double) ) ; 
s_old2= (double  *)  calloc (l+pstate->r, sizeof (double) ) ; 
s_old=(double  *)  calloc (l+pstate->r, sizeof (double) ) ; 

A0=(double  *)  calloc (l+pstate->r, sizeof (double) ) ? 

B0=(double  *)  calloc (l+pstate~>r, sizeof (double) ) ; 

Bl=(double  *)  calloc (l+pstate->r, sizeof (double) ) ; 

V=(double  *)  calloc (l+pstate“>r, sizeof (double) ) ; 

OMEGA=(doubie  *)  calloc (l+Dstate->r, sizeof (double) ) ; 

*/ 

/*printf(”\n  \n  Filter  Coefficients:”);*/ 
fprintf (f 3, ”\n  \n  Filter  Coefficients:  \r”) ; 

/*  Generate  the  Filter  Coefficients  for  the  First  Order  Section  */ 

if (pstate->N%2==l)  { 

tmp-sigmaO/lainbda ; 
pstate->a0  [  0 ]  =  1/  ( ( 2+tinp)  *lainbda)  ; 
pstate->al [ 0 ] =  pstate->a0 [ 0 ] ; 
pstate->bl  [  0 ]  =  -  ( 2-tinp) /  ( 2+tinp)  ; 
pstate->s [ 0 ] =0 ; 

/*printf(”\n  sigmaO  =  %10.5e  ”, sigmaO ) ;*/ 

/* 

printf(”\n  \n  a0[0]  =  %10.5e  ”,pstate->a0[0] ) ; 
printf(”\n  al[0]  =  %10.5e  ”,pstate->al[0] ) ; 
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printf(''\n  bl[0]  =  %10.5e  '',pstate->bl[0] )  ; 

*/ 

fprintf (f3,''\n  \n  a0[0]  =  %10.5e  \r'',pstate->a0[0]); 
fprintf  (f3, ''\n  al[01  =  %10.5e  \r",pstate->al[0]); 
fprintf (f 3, "Xn  bl[0]  =  %10.5e  \r",pstate->bl[0]); 

/*scanf  &T1)  ;*/  /*  Pause  */ 

}  /*  end  if  pstate->N%2==l  */ 

/*  Generate  the  Filter  Coefficients  for  the  Second  Order  Sections  */ 
s 1 ambda= 1 ambda  * lambda; 


for ( i*l ; i<=pstate->r ; i++) 
/*printf (''\n  i=  %2d 


if (pstate->N%2==l)  mu=i;  else  mu=i-0.5; 
for (m=0,dl=0;m<=4 ;m++)  . 

dl  +=  txpow(-1.0,m)*txpow(q,m*(m+l))*sin( (2*m+l) 


*PI*mu/pstate->N) 


for (m=l,d2=0;m<=5;m++) 

d2  +=  txpow(-l. 0,m) *txpow(q,m*m) *cos(2*m*PI*mu/pstate->N) ; 

0MEGA[i]=2*sqrt (sqrt (q) ) *dl/ (l+2*d2) ;  . ,  „  v  v 

V [ i ] =sqrt ( ( l-k*OMEGA [ i ] *OMEGA [ i ] ) * { 1-OMEGA [ i ] *OMEGA [ 1 ] /k) ) ; 
AOti]=l/(OMEGA[i]*OMEGA[i]) ; 
tmp=l+ssigmaO/AO[i] ; 

BO [ i ]  =  ( ss igmaC  *V [ i ] [ i ] +W*W/AO [ i ] ) / ( tmp*tmp ) ; 

Bl[i]=2*sigmaO*V[i]/tmp; 

tmp  =  4+2*Bl[i]/lambda+B0[i]/slambda; 

pstate->aO [ i ] =  ( 4+AO [ i ] /slambda) /tmp ; 

pstate->al[i]=  -2* (4-A0[i]/slambda)/tmp; 

pstate->a2  [ i ] =  pstate->aO [ i ] ; 

pstate->bl [ i ] =  -2  * ( 4 -BO [ i ] /slambda ) /tmp ; 

pstate->b2 [i]=  (4-2*Bl[i] /lambda+BO [ i ] /slambda ) /tmp ; 

pstate->s [ i ] =0 ; 

pstate->s_oldl [ i ] =0 ; 

/*  Print  Out  Filter  Coefficients  */ 


/* 

printf (”\n 
printf (”\n 
printf ("\n 
printf (”\n 
printf  (''\n 
printf  (''\n 
printf  (''\n 
printf (”\n 
*/ 


\n  A0[%d]  =  %10.5e  '',i,A0[i]); 
B0[%d]  =  %10.5e  ",i,B0[i]); 

Bl[%d]  =  %10.5e  ",i,Bl[i]); 
aOt%d]  =  %10.5e  ”, i,pstate->aO[i] ) ; 
al[%d]  =  %10.5e  ”, i,pstate->al[i] ) ; 
a2[%d]  =  %10.5e  ”,i,pstate->a2[i]) ; 
bl[%d]  =  %10.5e  ”, i,pstate->bl[i] ) ; 
b2[%d]  =  %10.5e  ”,i,pstate->b2[i]) ; 
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fprintf (f3,''\n  \n  aO[%d] 
fprintf  (f3, ''\n  al[%d]  = 
fprintf (f3 , ''\n  a2[%d]  = 
fprintf  (f3 , ''\n  bl[%d]  = 
fprintf  (f3 , ''\n  b2[%d]  = 


=  %10.5e  \r'', i,pstate-->aO[ 
%10.5e  \r" , i,pstate->al [ i] ) 
%10.5e  \r", i,pstate->a2 [i] ) 
%10.5e  \r'*,  i,pstate->bl[i] ) 
%10.5e  \r",i,pstate->b2[i] ) 


i]) 


/*scanf ("%d” , &T1) ;*/  /*  Pause  */ 


/*  Calculate  the  Gain  Ho  */ 

f or ( i=l , tmp=l . 0 ; i<=pstate->r ; i++ ) 
tmp  *=  BO[i]/AO[i]; 

if (pstate->N%2==l) 

pstate->Ho=sigTnaO*tinp; 

else 

pstate->Ho=tinp*exp (“In (10.0)  *Ap/20)  ; 

/*  Print  out  Ho  */ 

/*printf("\n  \n  Ho  =  %10.5f  '•,pstate->Ho)  ;*/ 
fprintf  (f 3, ''\n  \n  Ho  =  %10.5f  \r",pstate->Ho)  ; 

/*scanf (”%d",&Tl) ;*/  /*  Pause  */ 

)  /*  end  if  option  =*  2  */ 

/*  Error  Declarations  */ 
if  (option  ==  1)  { 

printf(''\n  OPTION  ERROR"); 
return ( 2 ) ; ) 

fprintf (f4, "%3d  \n  \r",pstate->N) ;  /*  print  filter  delay  in  file  */ 

if (no_output_fifos()  1=  l)  return(2) ; 
if (no_input_fifos()  !=  1)  return(3) ; 

fclose(fl) ; 
fclose(f2) ; 
f close (f 3) ; 
fclose(f4) ; 

pstate->tiine=0 ; 

pstate->finp=fopen("txinp.dat", "w") ;  /*  filter  input  data  file  */ 

pstate->fout=fopen("txout.dat","w") ;  /*  filter  output  data  file  */ 

)/*  end  if  (pstate==NULL)  */ 


if (length_output_fifo(0)  ==  maxlength_output_fifo(0) )  return (0) ; 
if (lengch_input_f ifo(O)  <1)  return ( 0) ; 

while (length_input_fifo(0)  >0) 
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{ 

if  (length_output_fifo(0)  ==  ]iiaxlength_output_f ifo (0) )  return ( 0)  ; 
get (0, &x) ; 

'*  Write  Filter  Input  Data  to  File  */ 
if (pstate->time<4*L) 

fprintf  (pstate->f  inp, ''\n  %f,  %f\r'’,  (float)pstate->time,x)  ; 
if (pstate->time==4*L-l)  fclose (pstate->f inp) ; 

/*  Generate  Filter  Output  */ 

X  *=  pstate->Ho; 

if  (pstate->N%2=»=l) 

{ 

s_old [ 0 ] =pstate->s [ 0 ] ; 

pstate->s [ 0 ] =x-pstate->bl [ 0 ] *s_old[ 0 ] ; 

x=pstate->aO [ 0 ] *pstate->s [ 0 ] +pstate->al [ 0 ] *s_old [ 0 ] ; 

} 

if (pstate->N>l) 

for ( i=l ; i<=pstate->r ; i++) 

{ 

s_old2 [ i ] =pstate->s_oldl [ i ] ; 
pstate->s_oldl [ i ] *pstate->s [ i ] ; 

pstate->s [ i ] =x-pstate->bl [ i ] *pstate->s_oldl [ i ] -pstate->b2 [ i ] *s_old2 [ i ] ; 
x=pstate->aO [ i ] *pstate->s [ i ] +pstate->al [ i ] *pstate->s_oldl [ i ] 

+pstate->a2 [ i ] *s_old2 [ i ] ; 

) 

put(0,x) ; 

/*  Write  Filter  Output  Data  to  File  */ 
if  (pstate->tiine<4*L) 

fprintf  (pstate->f  out,  ”\n  %f,  %f\r",  (float  )pstate->tinie,x)  ; 
if  (pstate->tiine==4*L-l)  fclose (pstate->fout)  ; 

pstate->tiTne++  ; 

) 

return (0) ; 

) 

/  **********  It*************  *************************************  *************** 

double  txpow(x,i) 
double  x; 
int  i; 

{ 

int  n; 
double  p; 
if (i==0) 
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/*****************  TXFIR.C  *******************/ 

/*  Function  txlpf()  */ 

/*  File  Parameter  Version  of  FIR  Filter  */ 

/*  Transmitter  Filter  Application  */ 

#  include  "type.h” 

#  include  "star.h" 

#  include  <stdio.h> 

#  include  <mth.h> 

#  define  PI  3.1415926535 

#  define  L  40 

typedef  struct  { 
int  none; 

}  PARAM,*PARAMPTR; 
typedef  struct  { 

double  inp[321],  h[321],  Ho; 
int  NN; 
int  time; 

FILE  *finp,  *fout; 

}  STATE, *STATEPTR; 

txlpf (pparam, size,pstate,pstar) 
int  size; 

PARAMPTR  pparam; 

STATEPTR  pstate; 

STARPTR  pstar; 

( 

SAMPLE  input , output ; 
double  TXBESSELO; 

double  tmp, tmpl, tmp2 , fs, Ap, Aa, fp, fa, wa,wc,wp,d,dl ,d2 , D, alpha, Aahat 
float  temp; 
int  i,N,n,T,Tl; 
char  *calloc() ; 

FILE  *fopen(),  *fl,  *f2,  *f3,  *f4; 
if  (pstate  ==  NULL  )  { 

pstate= (STATEPTR)  alloc_state_var(l, sizeof (STATE) ) ; 

f l=f open ( "chlf Itrl . tdt" , ”r" ) ; 
f 2=f open ( "chi f ltr2 . tdt" , " r " ) ; 

fscanf (fl, "%f" , Stemp) ;  /*  Read  Option  Type  */ 

T=( int) temp; 

f3=fopen("txf ilt.dat" , "w") ; 
f 4=f open ( "txdelay . dat" , "w" ) ; 

if  (T  ==  2)  { 

/*  Option  2  */ 

/*  Read  in  Filter  Specifications  */ 

fscanf (f2,"%lf",&fs) ; 
fscanf (f2,"%lf",&fp) ; 
fscanf (f 2, "%lf",&fa) ; 
fscanf (f 2, "%lf",&Ap) ; 
fscanf (f 2, "%lf",&Aa) ; 
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printf(''\n  \n  FIR  TRANSMITTER  FILTER  \n'')  ; 
fprintf  (f3,''\n  FIR  TRANSMITTER  FILTER  \n  \r'')  ; 
printf("\n  USER  FILTER  SPECIFICATIONS"); 
printf(”\n  Sampling  Frequency  =  %10.2f  Hz  ”,fs); 
printf(”\n  Passband  Edge  Frequency  =  %10.2f  Hz  ",fp); 
printf(”\n  Stopband  Edge  Frequency  =  %10.2f  Hz  ",fa); 
printf("\n  Maximum  Passband  Attenuation  =  %10.2f  dB  ”,Ap); 
printf(”\n  Minimum  Stopband  Attenuation  =  %10.2f  dB  ”,Aa) ; 

fprintf (f 3, "\n  USER  FILTER  SPECIFICATIONS  \r”); 
fprintf (f 3 , "\n  Sampling  Frequency  =  %10.2f  Hz  \r”,fs); 
fprintf (f3 , "\n  Passband  Edge  Frequency  =  %10.2f  Hz  \r",fp); 
fprintf (f 3 , ”\n  Stopband  Edge  Frequency  =  %10.2f  Hz  \r",fa); 
fprintf (f 3 , ”\n  Maximum  Passband  Attenuation  =  %10.2f  dB  \r”,Ap) 
fprintf (f 3, "\n  Minimum  Stopband  Attenuation  =  %10.2f  dB  \r”,Aa) 

printf("\n  \n  FILTER  DESIGN  RESULTS"); 
fprintf (f 3, "\n  \n  FILTER  DESIGN  RESULTS  \r"); 

/*  Calculating  Filter  Parameters  from  Specifications  */ 


wp=2*PI*fp/f s ; 
wa=2*PI*fa/fs; 
wc=(wa+wp)/2 ; 
dl=exp(-ln(10.0) *Aa/20) ; 
d=exp(ln(10.0) *Ap/20) ; 
d2=(d-l)/(d+l) ; 
if(dl<d2)  d=dl;  else  d=d2; 

Aahat=  -  20*logl0(d); 
pstate->Ho=l/ ( 1+d) ; 

printf("\n  Actual  Stopband  Attenuation  =  %10.2f  dB  ",Aahat); 
fprintf (f 3 , "\n  Actual  Stopband  Attenuation  =  %10.2f  dB  \r",Aahat) 

/*printf("\n  Gain  Adjustment  =  %10.2f  ",pstate->Ho) ;*/ 

if (Aahat<=21)  { 
alpha=0 ; 

D=0.9222; } 

else  if  (Aahat>50) 

alpha=0.1102*(Aahat-8.7) ; 

else 

alpha=0.5842*exp(0.4*ln(Aahat-21) ) +0.07886* (Aahat-21) ; 

if (Aahat>21) 

D= ( Aahat-7 . 95) /14 . 36 ; 

tmp=l+D*2*PI/ (wa-wp) ; 

for(N=l;N<1000;N  +=  2)  if(N>=tmp)  break; 

printf("\n  Filter  Order  =  %3d  ",N); 
fprintf (f 3 , "\n  Filter  Order  =  %3d  \r",N); 
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/*printf (''\n  alpha  =  %10.2f  ”, alpha);*/ 
/*printf(”\n  D  =  %10f  ”,D);*/ 


if  (N>=320)  { 

printf(”\n  FILTER  ORDER  OUT  OF  RANGE"); 
return ( 3 ) ; } 

/*scanf ("%d",&Tl) ;*/  /*  Pause  */ 

/*  Calculating  the  Filter  Coefficients  */ 
pstate->NN= (N-1) /2 ; 

/*  pstate->inp  =  (double  *)  calloc(2*pstate->NN+l, sizeof (double) ) ; 
pstate->h  =  (double  *)  calloc(2*pstate“>NN+l, sizeof (double) ) ; 

*/ 

/*printf(”\n  \n  Filter  Impulse  Response:  \n”) ;*/ 
fprintf (f3,"\n  \n  Filter  Impulse  Response:  \n  \r”) ; 

f or ( n=  -pstate->NN ; n<=pstate->NN ; n++ ) 

{ 

if (n==0) 
tmp=wc/PI ; 
else 

tmp=sin(n*wc)/ (PI*n) ; 


tmpl=(n*l. 0)/pstate->NN; 

tmp2=TXBESSEL(alpha*sqrt (l-tmpl*tmpl) )/TXBESSEL( alpha) ; 
pstate->h [ n+pstate->NN] =tmp*tmp2 ; 

/*printf(”\n  h[%d]  =  %10.5e  ”,n+pstate->NN,pstate->h[n+pstate->NN] ) ;*/ 
fprintf (f3 , ”\n  h[%d]  =  %10.5e  \r” ,n+pstate->NN,pstate->h[n+pstate~>NN] ) ; 

} 

/*scanf (”%d”,&Tl) ;*/  /*  Pause  */ 

)  /*  end  if  (T  ==  2) ,  Option  2  */ 


if  (T  ==  1)  ( 

/*  Option  1  -  Read  in  the  Filter  Order  and  Sampling  Frequency  */ 

fscanf (fl,"%f",&temp) ; 

N=(int) temp; 
fscanf (fl,"%lf",&fs) ; 
fscanf (fl,"%lf",&fp) ; 

printf(”\n  \n  FIR  TRANSMITTER  FILTER  \n”) ; 
printf ("\n  USER  FILTER  SPECIFICATIONS”) ; 
printf(”\n  Filter  Order  »  %3d  ”,N); 
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printf(''\n  Sampling  Frequency  =  %10.2f  Hz  '',fs); 
printf(''\n  Cutoff  Frequency  =  %10.2f  Hz'',fp); 
fprintf  (f3,  "Xn  USER  FILTER  SPECIFICATIONS  \r''); 
fprintf  (f3 ,  "\n  Filter  Order  =  %3d  \r'',N); 
fprintf  (f3 ,  "\n  Sampling  Frequency  =  %10.2f  Hz  \r'',fs); 
fprintf  (f 3 ,  "Xn  Cutoff  Frequency  =  %10.2f  Hz  Xr'',fp); 

if  (N>=320)  { 

printfC'Xn  FILTER  ORDER  OUT  OF  RANGE"); 
return ( 3 ) ; } 

/*  Read  in  the  Filter  Coefficients  */ 
pstate->NN= (N-1) /2 ; 

/*  pstate->inp  =  (double  *)  calloc(2*pstate->NN+l,sizeof (double) ) ; 
pstate->h  =  (double  *)  calloc(2*pstate->NN+l, sizeof (double) ) ; 

*/ 

/*printf("Xn  Xn  Filter  Impulse  Response:  XJ^")  **/ 
fprintf (f 3 , "Xn  Xn  Filter  Impulse  Response:  Xn  Xr") ; 


for ( n=  -pstate->NN ; n<=pstate->NN ; n++) 

{ 

fscanf (fl, ”%lf ” , &pstate->h[n+pstate->NN] ) ; 

/*printf("Xn  h[%d]  =  %10.5e  ”,n+pstate->NN,pstate->h[n+pstate->NN] ) ;*/ 
fprintf (f3 , "Xn  h(%d]  =  %10.5e  Xr"»n+pstate->NN,pstate->h[n+pstate->NN] ) 

)  /*  end  for  */ 

pstate->Ho=l ; 

/*scanf ("%d",&Tl) ;*/  /*  Pause  */ 

}  /*  end  if  (T  ==  1)  -  Option  1  */ 

for ( i=2*pstate->NN-l ; i>=0 ; i — )  pstate->inp [ i ] =0 ; 

fprintf (f 4, "%3d  Xn  Xr" ,pstate->NN) ;  /*print  filter  delay  in  txdelay.dat*/ 

if (no_output_fifos()  !=  1)  return (2 ) ; 
if (no_input_fifos()  !=  l)  return (3 ) ; 

pstate->time=0 ; 

pstate->finp=fopen("txinp.dat" , "w") ;  /*  filter  input  data  file  */ 

pstate->fout=fopen("txout.dat" , "w") ;  /*  filter  output  data  file  */ 

fclose(fl) ; 
f close (f 2) ; 
fclose(f3)  ; 
f close (f 4)  ; 

)  /*  end  if  (pstate  ==  NULL  */ 
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if (length_output_fifo(0)  ==  maxlength_output_fifo(0) )  return ( 0) ; 
if (length_input_fifo(0)  <1)  return (0) ; 


while (length_input_f if o(0)  >0) 

{ 

if  (length_output_fifo(0)  ==  inaxlength_output_fifo(0) )  return ( 0)  ; 
get (0, & input) ; 

/*  Write  Filter  Input  Data  to  File  */ 
if (pstate->time<4*L) 

fprintf  (pstate->f  inp, ''\n  %f,  %f\r'',  (float)  pstate->time,  input)  ; 
if  (pstate->tiine==4*L-l)  fclose (pstate->finp)  ; 

/*  Perform  Convolution  to  Generate  Filter  Output  */ 

input  *=  pstate“>Ho; 

for ( i=2*pstate->NN-l ; i>=0 ; i — )  pstate->inp [ i+1 ] =pstate->inp [ i ] ; 
pstate->inp [ 0 ] =input ; 
output=0 ; 

for ( n=  -pstate->NN ; n<=pstate->NN ; n++) 

output  +=  pstate->h[n+pstate->NN]*pstate->inp[n+pstate->NN] ; 
put (0, out put) ; 

/*  Write  Filter  Output  Data  to  File  */ 
if (pstate->time<4*L) 

fprintf  (pstate->fout,  "\n  %f,  %f\r'',  (float) pstate->time, output)  ; 
if (pstate->time==4*L-l)  fclose (pstate->f out) ; 

pstate->time++ ; 

) 

return (0) ; 

} 

double  TXBESSEL(x) 
double  X ; 

{ 

double  I0,t,t2; 

t=x/3.75; 

t2=t*t; 

if(X>=0  &&  X<=3.75) 

I0=l+t2* (3 . 5156229+t2* (3 . 0899424+t2* (1. 2067492+t2* (0 . 2659732 
+t2*(0.0360768+t2*0. 0045813) ) ) ) ) ; 
else  if(x>3.75) 

10=(exp(x)/sqrt(x) ) *(0.39894228+ (0.01328592+ (0.002253 19 

+(-0.00157565+ (0.00916281+ (-0.02057706 

+(0. 02635537+ (-0. 01647633+0. 00392377/t)/t)/t)/t)/t)/t)/t)/t) ; 
return (10) ; 

} 
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/***************  VIT3.C  (  VITERBI  DECODER  (3,1/2)  )  **************/ 

/*  Function  viterbi()  */ 

tinclude  <stdio.h> 
include  "type.h” 

# include  "star.h" 
fdefine  NORM  pstate->nonn 

fdefine  METRIC  pstate->metric 
fdefine  SURV  pstate->surv 

fdefine  TIME  pstate->tiine 
fdefine  K  pstate->k 

fdefine  NS  4 

fdefine  T  32 

typedef  struct  ( 

unsigned  int  surv[NS]; 
float  metric [ NS ], norm; 
int  k [NS], time; 

}  STATE,  *STATEPTR; 

viterbi  (file_name, si2e,pstate,pstar) 

STATEPTR  pstate; 

STARPTR  pstar; 
char  *file_name; 
int  size; 

{ 

SAMPLE  recO,recl,u; 

unsigned  int  j , i,h,s,t,ssurv[NS] ; 

float  branch[4] , LO, Ll,mmetric(NS] ; 

if  (pstate  ==  NULL) 

{ 

pstate  =  (STATEPTR)  alloc_state_var(l,sizeof (STATE) ) ; 
if  (no_input_fifos(  )  !=1  | |  no_output_f ifos (  )  !=1)  return (3) 

TIME=T-1; 

printf (”\nTrunc.  Length  =  %d'',T); 
for ( j=0; j<NS; j++) 

{ 

K[j]=2*(j%2)  +  ((j*j»l)%2); 

METRIC[j]*10000; 

SURV[j]=0; 

} 

METRIC[0]=0; 

NORM=0 ; 

} 

if (Iength_output_fifo(0)==maxlength_output_fifo(0) )  return(O) ; 
if (length_input_fifo(0) %2  !=  0)  return(34); 

while (length_input_fifo(0)  >  1) 
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{ 

if  ( length_output_f if o ( 0)  ==inaxlength_output_f if o ( 0) )  return (0)  ; 
get (0, SrecO) ; 
get (0, Srecl)  ; 

branch [0]=(rec0+l) * (recO+1) + (recl+1) *(recl+l) ; 
branch[l]=(recO+l) * (recO+1) + (recl-1) * (recl-1) ; 
branch[2]= (recl+1) * (recl+1) + (recO-1) *(recO“l) ; 
branch[3]=(rec0-l) * (recO-1) + (recl-1) *(recl-l) ; 
/******************************************************************/ 

h=TIME — ; 

if(TIME<0)  TIME  +=  T; 
s=’  (01«h)  ; 

for(j=0; j<NS; j++)  { ssurv [ j ] =SURV [ j ] ;  imnetric[ j ]=METRIC[ j ]-NORM; } 

NORM=100000; 
for( j=0; j<NS; j++) 

{ 

i=j»l; 

LO=ininetric[i]+branch[K[  j  ]  ] ; 

Ll=ininetr ic [ i  2]+branch[3-K[  j  ]  ] ; 

if  (LI  <  LO)  (METRIC[j]=Ll;  SURV[  j  ]  =  (ssurv[  ( j »1)  |  2  ]  &  s)  |  ( ( j &01)  «h)  ; ) 
else  {METRIC[j]=LO;  SURV[  j  ]  =  (ssurv[  j»l]  &  s)  |  ( ( j&Ol)  «h)  ; ) 

if (  METRIC [ j ] <NORM)  { NORM=METRIC [ j ] ;  t= j ; } 

) 

u=  (SAMPLE)  ( (SURV[t]  »TIME)&01); 
put(0,u) ; 

} 

return  ( 0 )  ; 

} 
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/****  VIT3Q.C  (VITERBI  DECODER  (3,1/2)  FOR  SOFT  DEC  QPSK)  ****/ 

/*  Function  viterbi()  */ 

# include  <stdio.h> 

# include  "type.h" 

# include  "star.h” 
fdefine  NORM  pstate->nonn 
#define  METRIC  pstate-->inetric 

fdefine  SURV  pstate->surv 

fdefine  TIME  pstate->tiine 

fdefine  K  pstate->k 

fdefine  NS  4 

fdefine  T  32 

fdefine  SCALE  0,7071068 

typedef  struct  { 

unsigned  int  surv[NS]; 
float  metric [ NS ], norm; 
int  k [NS], time; 

}  STATE,  *STATEPTR; 

viterbi  ( f ile_name , size , pstate , pstar ) 

STATEPTR  pstate; 

STARPTR  pstar; 
char  *file_name; 
int  size; 

{ 

SAMPLE  recO,recl,u; 

unsigned  int  j , i,h,s,t,ssurv[NS] ; 

float  branch[4] , LO, Ll,mmetric[NS] ; 

if  (pstate  "  NULL) 

{ 

pstate  =  (STATEPTR)  alloc_state_var (1, sizeof (STATE) ) ; 
if  (no_input_f ifos (  )  !=1  ||  no_output_f ifos (  )  !=1)  return (3 ) ; 

TIME=T-1; 

printf (''\nTrunc.  Length  =  %d”,T); 
for( j=0; j<NS; j++) 

I 

K[j]=2*(j%2)  +  ((j‘j»l)%2)  ; 

METRIC[ j ]=10000; 

SURV[j]=0; 

} 

METRIC[0]=0; 

NORM=0 ; 

} 

/***************1Hi*****1t***k********1Ht1Hfk************1fk**ii.*ii*mi-k1tii*1t*1t/ 

if (length_output_fifo(0) ==maxlength_output_fifo(0) )  return (0) ; 
if (length_input_fifo(0) %2  1=  0)  return ( 34 ) ; 


113 


while (length_input_fifo(0)  >  1) 

{ 

if  ( length_output_f if o ( 0 )  ==inaxlength_output_f if o ( 0 ) )  return ( 0)  ; 
get (0, &rec0) ; 
get (0, &recl) ; 

branch[0]=(rec0+SCALE) *(recO+sCALE)+(recl+sCALE) *(recl+SCALE) ; 
branch [ 1 ] = ( recO+SCALE) * (recO+SCALE) + (recl-SCALE) * (recl-SCALE) ; 
branch[2]=(recl+SCALE) *(recl+SCALE)+(recO-SCALE) *(recO-SCALE) ; 
branch[  3  ]  =  (recO-SCALE)  *(recO-SCAIiE)  +  (recl-SCALE)  *  (recl-SCALE)  ; 

/It*****************************************************************/ 
h=TIME — ; 

if(TIME<0)  TIME  +=  T; 
s='  (01«h)  ; 

for(j=0;  j<NS;  j++)  {ssurv[j  ]=SURV[  j] ;  nimetric[  j  ]=METRIC[  j  ] -NORM; } 

NORM=100000; 
for ( j=0; j<NS; j++) 

{ 

i=j»l; 

L0=inmetr  ic  [  i  ]  +branch  [K[j]]; 

Ll=nmetric[i I 2]+branch[3-K[ j ] ] ; 

if(Ll  <  LO)  {METRIC[j]=Ll;  SURV[  j  ]  =  (ssurv  [  ( j  »1)  |  2  ]  &  s)  |  ( ( j &01)  «h)  ; ) 
else  (METRICC  j  ]=L0;  SURV[  j  ]  =  (ssurv[  j»l]  &  s)  |  ( ( j&Ol)  «h)  ; ) 

i f (  METRIC [ j ] <NORM)  ( NORM=METRIC [ j ] ;  t= j ; } 

) 

U=  (SAMPLE)  (  (SURV[t]  »TIME)  &01)  ; 
put(0,u) ; 

} 

return  ( 0 )  ; 

) 
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/***************  VIT7.C  (  VITERBI  DECODER  (7,1/2)  )  **************/ 

/*  Function  viterbi()  */ 

# include  <stdio.h> 

# include  "type.h” 

# include  "star.h" 

Idefine  NORM  pstate->nonn 

Idefine  METRIC  pstate->inetric 

Idefine  SURV  pstate->surv 

Idefine  TIME  pstate->time 

Idefine  K  pstate-:>k 

Idefine  NS  64 

Idefine  T  32 

typedef  struct  ( 

unsigned  int  surv[NSi; 
float  metric [ NS ], norm; 
int  k[ NS], time; 

}  STATE,  *STATEPTR; 

viterbi  (file_name, size,pstate,pstar) 

STATEPTR  pstate; 

STARPTR  pstar; 
char  *file_name; 
int  size; 

{ 

SAMPLE  recO,recl,u; 

unsigned  int  j , i,h,s,t,ssurv[NS] ; 

float  branch[4] ,LO,Ll,mmetric[NS] ; 

if  (pstate  ==  NULL) 

{ 

pstate  =  (STATEPTR)  alloc_state_var ( 1 , sizeof (STATE) ) ; 
if  (no_input_fifos(  )  !=1  | |  no_output_f ifos {  )  !=1)  return(3) 

TIME=T-1; 

printf ("\nTrunc.  Length  =  %d",T); 
for ( j=0; j<NS ; j++) 

{ 

K[j]=2*(  (j*j»2“j»3“j»5)%2)  +  (  (j'j»l*j»2‘j»3)%2)  ; 

METRIC[j]=10000; 

SURV[ j]=0; 

} 

METRIC [0]=0; 

NORM=0 ; 

} 

Z*********************************************************************/ 

if (Iength_output_fifo(0)=*maxlength_output_fifo(0) )  return (0) ; 
if (length_input_f ifo(O) %2  !=  0)  return ( 34 ) ; 

while(length_input_fifo(0)  >  1) 
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{ 

if  (length_output_fifo(0)  ==inaxlength_output_fifo(0) )  return (0)  ; 
get (0, SrecO) ; 
get (0, Srecl) ; 

branch[0]=(rec0+l) * (recO+1) + (recl+1) * (recl+1) ; 
branch[l]=(recO+l) * (recO+1) + (recl-1) * (recl-1) ; 
branch[2]= (recl+1) * (recl+1) + (recO-1) *(recO-l) ; 
branch[3]=(recO-l) * (recO-1) + (recl-1) * (recl-1) ; 

/It***************************  *************************  It************/ 

h=TIME—  ? 

if(TIME<0)  TIME  +=  T; 
s='  (01«h)  ; 

for(  j=0;  j<NS;  j++)  (ssurv[  j  ]=SURV[  j  ] ;  nunetric[  j  ]=METRIC[  j  ] -NORM; } 

NORM=100000; 
for ( j=0 ; j  <NS ; j  ++ ) 

( 

i=j»l; 

LO=ininetr ic  [  i  ]  +branch  [  K  [  j  ]  ] ; 

Ll=ininetr ic  [  i  1 3  2  ]  +branch  [  3  -K  [  j  ]  ] ; 

if(Ll  <  LO)  (METRICC  j]=Ll;  SURV[  j  ]  =  (ssurv[  (  j»l)  |  32]  &  s)  |  (  ( j &01)  «h)  ;  } 
else  {METRIC[j]=LO;  SURV[  j  ]  =  (ssurv[  j»l]  &  s)  j  ( ( j&Ol)  «h)  ; } 

if (  METRIC [ j ] <NORM)  ( NORM=METRIC [ j ] ;  t= j ; } 

} 

u=  (SAMPLE)  ((SURV[t]  »TIME)&01)  ; 
put(0,u) ; 

) 

return  (0)  ; 

) 
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/****  VIT7Q.C  (  VITERBI  DECODER  (7,1/2)  FOR  SFT  DEC  QPSK)  ****/ 

/*  Function  viterbi()  */ 

# include  <stdio.h> 

# include  "type.h" 

# include  "star.h” 

#define  NORM  pstate“>norm 
#define  METRIC  pstate->metric 
#define  SURV  pstate->surv 

fdefine  TIME  pstate->time 
#define  K  pstate->k 

#define  NS  64 

Idefine  T  32 

#define  SCALE  0.7071068 

typedef  struct  { 

unsigned  int  surv[NS]; 
float  metric [ NS ], norm; 
int  k[ NS], time; 

}  STATE,  *STATEPTR; 

viterbi  ( f ile_name , size , pstate , pstar ) 

STATEPTR  pstate; 

STARPTR  pstar; 
char  *file_name; 
int  size; 

{ 

SAMPLE  recO,recl,u; 

unsigned  int  j ,i,h,s,t,ssurv[NS] ; 

float  branch [ 4 ] , LO , LI , mmetr ic [ NS ] ; 

if  (pstate  ==  NULL) 

{ 

pstate  =  (STATEPTR)  alloc_state_var (1, sizeof (STATE) ) ; 
if  (no_input_fifos (  )  !=1  ||  no_output_f ifos (  )  !=1)  return (3 ) ; 

TIME=T“1 ; 

printf (''\nTrunc.  Length  =  %d”,T); 
for ( j=0; j<NS; j++) 

{ 

K[j]=2*((j*j»2*j»3*j»5)%2)  +  (  (j“j»l‘j»2'j»3)%2)  ; 

METRIC[j  3=10000 ; 

SURV[j]=0; 

} 

METRIC[0]=0; 

NORM=0 ; 

} 

if (Iength_output_fifo(0)==maxlength_output_fifo(0) )  return(O) ; 
if (length_input_fifo(0) %2  !=  0)  return ( 34 ) ; 
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while (length_input_fifo(0)  >  1) 

{ 

if  (length_output_f if o(0)  ==inaxlength_output_f ifo (0) )  return (0)  ; 
get(0,&rec0) ; 
get (0, fired)  ; 

branch[0]=(rec0+SCALE) *(recO+SCALE)+(recl+SCALE) *(recl+SCALE) ; 
branch[l]=(recO+SCALE) *(recO+SCALE)+(recl-SCALE) *(recl-SCALE) ; 
branch[2]=(recl+SCALE) *(recl+SCALE)+(recO-SCALE) *(recO-SCALE) ; 
branch[3]=(rec0-SCALE) *(recO-SCALE)+(recl-SCALE) *(recl-SCALE) ; 

y-k-khlfk-k’kifklfk'k'kifkltlfkltle-kifklfkltltlllfkltliltltltlfiilfk-lfkifkltlfkifklfklfkislfk'klfk-kltlfklfklfky 

h=TIME—  ; 

if(TIME<0)  TIME  +=  T; 
s=*  (01«h)  ; 

for ( j =0 ; j  <NS ; j  ++ )  { ssurv [ j ] =SURV [ j ] ;  mraetr ic [ j ] =METRIC [ j ] -NORM ; } 

NORM=100000; 
f or ( j  =0 ; j  <NS ; j  ++ ) 

{ 

i=j»l; 

L0=ininetr ic  [  i  ]  +branch  [  K  [  j  ]  ]  ; 

Ll=inmetr ic  [  i  j  3  2  ]  +branch  [  3  -K  [  j  ]  ] ; 

if  (LI  <  LO)  {METRIC[  j  ]=L1;  SURV[  j  ]  =  (ssurv[  ( j»l)  |  32  ]  fi  s)  |  (  ( j  fiOl)  «h)  ;  ) 
else  {METRIC[  j  ]=L0;  SURV[  j  ]  =  {ssurv[  j»l]  fi  s)  ]  ( ( j fiOl)  «h)  ; ) 

if(  METRICC j ]<NORM)  { NORM=METRIC [ j ] ;  t= j ; ) 

} 

U=(SAMPLE)  (  (SURV[t]  »TIME)  fiOl)  ; 
put(0,u) ; 

} 

return  ( 0 )  ; 

} 
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(A**************************  ALOHA. PAS  ************************** } 

PROGRAM  inultiple_channel_slotted_aloha  (input,  output) ; 

{$!  sci-graf . inc} 

CONST 

channel_max 
station_inax 
trial_inax 
f i 1 e_s i z e_max 
default__plot_interval 
dot_display_freq 
post_text_f i 1 e 
plot_disk_f ile 
post_delay_f ile 
post_throughput_f ile 
post_queue_f ile 
input_f ile 

TYPE 

strSO  =  packed  array[1..80]  of  char; 

label_naine  =  string [80]  ; 

plot_type  =  (delay_curve,  throughput,  queue_size) ; 

channel_nuniber  =  0 . .  channel_inax; 

station^number  =  0 . .  station_inax; 

trial_number  =  0 . .  trial_inax; 

event_kind  =  (arrival,  transmission,  re_transmission, 

resolution,  departure,  END_of_slot) ; 
channel_state  =  (idle,  busy,  collision) ; 
link  =  ‘event; 
event  - 

RECORD 

fptr,  bptr  ;  link; 
kind  :  event_kind; 

time  :  double; 

arrival_tirae  :  double; 
trial_no  :  triaT_number ; 
channel_no  :  channel_nuraber; 
station_no  ;  station_number 
END; 


=  10; 

=  20; 

=  20; 

=  100; 

=  10; 

=  1000; 

=  ' pos tt  ext . dat ' 
=  'plotfile.dat' 
=  'posdelay.dat* 
=  ' posthrpt . dat ' 
=  ' posqueue . dat ' 
=  ' aloha. tdt'; 


VAR 

num_o  f _a  rv ,  num_o  f _depa rt 
mean_time 
state 
nel_state; 
glma 

average_delay ,  variance_delay 


:  ARRAY  [station_number]  OF  longint; 
:  ARRAY  [event_kind]  OF  double; 

;  ARRAY  [channel_number ]  OF  chan- 

:  ARRAY  [1..55]  OF  double; 

;  ARRAY  [station_number]  OF  double; 


user,  population,  station,  channel,  uniform_seed,  exp_seed 

max_traffic,  input_rate,  max_time,  service_time 

current_event ,  base 

event_index 

station_total 

channel  total 


integer; 

double; 

link; 

event_kind; 
station_number 
channel  number 
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backlog,  glinext,  glinextp 


:  integer ; 


{  graphics  oriented  variables  } 

configuration_file,  text_file  :  text; 

plot_file,  delay_file,  throughput_f ile,  queue_file  :  text; 

plot_yesno,  plot_int  :  integer; 

plot_channel ,  plot_interval  :  integer; 

plot_f actor  :  double; 

plot_switch  :  boolean; 

plot  :  plot_type; 

namel,  naine2,  naine3,  naine4,  names,  names  :  strSO; 


{$!  header. inc} 


FUNCTION  ran 3 (VAR  idum;  integer):  double; 
CONST 


mbig 

mseed 

mz 

fac 

VAR 


4 . 0e6 ; 

1618033.0; 

0.0; 

2.5e-7;  (*  1/mbig  *) 


i,ii,k  :  integer; 

mj,mk  :  double; 


BEGIN 

if  (idum  <  0)  then 
BEGIN 

mj  ;=  mseed+idum; 

if  mj>=0.0  then  mj  ;=  mj-mbig*trunc (mj/mbig) 

else  mj  ;=  mbig-abs(mj)+mbig*trunc(abs(mj)/mbig) ; 
glma[55]  :=  m j ; 
mk  : =  1 ; 

for  i  ;=  1  to  54  do 
BEGIN 

ii  ;=  21*i  mod  55; 
glma[ii]  ;=  mk; 
mk  :=  mj-mk; 

if  (mk  <  mz)  then  mk  ;=  mk+mbig; 
mj  :=  glma[ii] 

END; 

for  k  :=  1  to  4  do 
BEGIN 

for  i  ;=  1  to  55  do 
BEGIN 

glma[i]  :=  glma[i]-glma[l+( (i+30)  mod  55)]; 
if  (glma[i]  <  mz)  then  glma[i]  :=  glma[i]+mbig 
END 

END; 

glinext  ;=  0; 
glinextp  :=  31; 
idum  :  =  1 
END; 

glinext  :=  glinext+1; 

if  (glinext  =  56)  then  glinext  ;=  1; 


120 


1 


glinextp  ;=  glinextp+1; 
if  (glinextp  =  56)  then  glinextp  := 
mj  :=  glma [glinext]-glina [glinextp] ; 
if  (mj  <  mz)  then  mj  :=  mj+mbig; 
glma[glinext]  :=  m j ; 
ran3  ;=  inj*fac 
END; 


procedure  str_to_pack(  in_str  ;  label_name; 

var  pack_str  :  strSO  ) ; 

var 

max_length,  element  :  integer; 

BEGIN 

max_length  :=  length (in_str) ; 
for  element  :=  1  to  max_length  do 

pack_str[ element]  :=  in_str [ element ] ; 
pack_str [max_length+l]  ;=  chr(O) ; 

END; 


procedure  plot_initialize; 

BEGIN 

case  plot_int  of 

1  :  plot  :=  delay_curve; 

2  :  plot  :=  throughput; 

3  ;  plot  ;*  queue_size; 

END; 

auto_select_display ; 
virtual_display (YES) ; 
hr ange ( max_t ime ,  0.0); 
case  plot  of 
delay_curve  ; 

BEGIN 

str_to_pack( • Delay  vs  Time',  namel) ; 
str_to_pack( 'Simulation  Time  (slots) ' ,name2) ; 
str_to_pack (' Average  Delay  (slots) ' ,name3) ; 
vrange(trial_max*1.0,  0.0) ; 

END; 

throughput  ; 

BEGIN 

str_to_pack (' Throughput  vs  Time',  namel); 
str_to_pack( 'Simulation  Time  (slots) ' ,name2) ; 
str_to_pack( 'Average  Throughput' ,name3) ; 
vrange (1.0  *  channel_total ,  0.0); 

END; 

queue_slze  : 

BEGIN 

str_to_pack (' Queue  Size  vs  Time',  namel); 
str_to_pack( 'Simulation  Time  (slots) ' ,name2) ; 
str_to_pack (' Average  Queue  Size' ,name3) ; 
vrange(10.0,  0.0); 

END; 
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END;  {  END  case  } 
graph_type (ORDINARY) ; 
line_connect (NO) ; 
display_onscreen(YES) ; 

syinbols(DOT,  DOT,  DOT,  DOT,  DOT,  SQUARE); 
hlbl_prec(l) ; 
vlbl_prec(3) ; 
clear_display (NO,  YES) ; 

title (CENTER,  namel) ; 
haxis_lbl (CENTER,  name2) ; 
vaxis_lbl  (CENTER,  naine3); 

display_window(643 ,  0,  900,  0) ; 
graph_init ; 

END; 


procedure  plot_graph (disk_f ile  ;  label_name) ; 

BEGIN 

str_to_pack( ' ' , namel) ; 
str_tojpack ( ' ' , name2 ) ; 
str_to_pack( ' ' ,name3) ; 
str_to_pack ( ' ' , name4 ) ; 
str~to_pack( ' ' ,name5) ; 
str_to_pack(disk_f ile, names) ; 

plot_pairs (namel,  name2,  name3,  name4,  names,  names,  1) ; 
clear_display (NO,  NO) ; 
background (NO) ; 

END; 


FUNCTION  expdev(VAR  idum:  integer) :  double; 
BEGIN 

expdev  ; =  -In ( ran3 ( idum) ) /mean_time [arrival ] 
END; 


PROCEDURE  collision_resolution(  trial;  trial_number; 

VAR  next_transmission_time;  double) ; 

VAR 

K_max  :  double; 

BEGIN 

K_max  ;=  mean_time[re_transmission] ; 

next_transmission_time  :=  K_max  *  ran3 (uniform_seed) ; 

END; 


PROCEDURE  inter_arrival_time  (VAR  next_arrival :  double); 
BEGIN 

next_arrival  ;=  expdev (exp_seed) ; 

END; 
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PROCEDURE  generate_event  (evkind  :  event_kind; 

current_time:  double; 
arv_tiine  :  double; 

trial  :  trial_nuinber; 

channel  :  channel_nuinber ; 

station  :  station_number) ; 

VAR 

event , new_event  :  link; 
delay  :  double; 

BEGIN 

new(new_event) ; 

CASE  evkind  OF 

arrival;  {  next  arrival  } 

BEGIN 

inter_arrival_tiiQe  (delay)  ; 
arv_time  ;=  current_tiine  +  delay; 
new_event " . time  : =  arv_t ime ; 

END; 

transmission:  {  time  to  next  slot  } 

BEGIN 

new_event* . time  :=  trunc (current_time)  +  1.0001; 

END; 

resolution:  {  resolution  is  scheduled  at  the  middle  of  the  slot  } 
BEGIN 

new_event* .time  ;=  current_time  +  0.5; 

END; 

re_transmission;  {  schedule  next  transmission  time  ) 

BEGIN 

collision_resolution (trial,  delay) ; 

new_event‘‘ .  time  ;=  trunc ( cur rent_t ime  +  delay  +  0.4999)  +  0.0001; 
END; 

departure:  {  total  packet  transmission  time  is  one  slot  ) 

BEGIN 

new_event* . time  ;=  current_tiroe  +  0.4999; 

END; 

END_of_slot; 

BEGIN 

new_event* . time  :=  current_time  +  1.0; 

END; 

END;  {  END  CASE  } 

WITH  new_event‘  DO 
BEGIN 

kind  ; «  evkind ; 
arrival_time  ;=  arv_time; 
trial_no  ;=  trial; 
channel_no  : =  channel ; 
station_no  ;=  station; 

END;  {  with  ) 
event  : =  base ; 

REPEAT 

event  ; =  event  * . bptr 
UNTIL  new_event* .time  >=  event*. time; 
new_event  * . f ptr  : =  event  * . f ptr ; 
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new_event  * . bptr  : =  event ; 
event  * . f ptr  * . bptr  : =  new_event ; 
event  * . f ptr  : =  new_event ; 

END;  {  genera te_event  } 


BEGIN 

{  initialize  variables  } 
station_total  :=  1; 
exp_seed  :=  -1; 
uniforin_seed  ;=  -1; 

reset (configuration_file,  input_file) ; 
readln(configuration_file,  population) ; 
reading configuration_file,  channel_total ) ; 

FOR  user  :=  1  TO  station_max  DO 
BEGIN 

readln(configuration_file,  input_rate) ; 

mean_time[ arrival]  ;=  mean_tiine[ arrival]  +  input_rate; 

END; 

readln(configuration_file,  max_time) ; 
readln(configuration_file,  plot_int) ; 
readln(configuration__file,  plot_yesno)  ; 
readln(configuration~file,  mean_tiine[re_transmission] )  ; 
close (configuration_file) ; 

niax_traffic  :=  mean_tiine [ arrival ] ; 
plot_factor  :=  (max_traffic  *  max^time) 

/  (file_size_inax  *  default_plot_interval)  ; 
plot_interval  ;=  default_plot_interval; 
if  plot_factor  >  1.0  then 

plot_interval  ;=  default_plot_interval  *  trunc (plot_f actor  +  1.0); 

rewrite (text_file,  post_text_f ile) ; 
rewrite (delay_file,  post_delay_file) ; 
rewrite (throughput_f ile,  post_throughput_f ile) ; 
rewrite (queue_f ile,  post_queue_f ile) ; 
rewrite (plot_f ile,  plot_disk_file) ; 

writeln(text_file,  'Multiple  Access  Protocol  -  ALOHA  (multiple  channels)') 
writeln(text_file) ; 

writeln(text_file,  'Simulation  Results:'); 

writeln(text_file,  'Simulated  Time  Average  Delay  Throughput'); 

plot_switch  ; =  TRUE ; 
case  plot_yesno  of 

1  :  plot_switch  :=  TRUE; 

0  ;  plot_switch  :=  FALSE; 

END;  {  END  case  } 

IF  plot_int  =  0  THEN  plot_switch  ;=  FALSE; 
if  (not  plot_switch)  then  writeln( 'Running. . . ' ) ; 

(  create  an  empty  event  ring  } 
new (base) ; 
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WITH  base*  DO 
BEGIN 

f ptr  : =  base ; 
bptr  ; =  base ; 
time  :=  0.0 
END; 

{  generate  arrival  at  each  station  } 

FOR  station  ;=  1  TO  station_total  DO 
BEGIN 

average_delay [station]  :=  0.0; 
variance_delay [station]  ;=  0.0; 
nxim_of_arv[ station]  :=  0; 
num_of_depart[ station]  :=  0; 

FOR  channel  :=  1  TO  channel_total  DO 

generate_event (arrival,  0.0,  0.0,  0,  channel,  station); 

END; 

{  generate  initial  conditions  for  each  channel  ) 

FOR  channel  :=  l  TO  channel_total  DO 
BEGIN 

generate_event(END_of_slot,  0.0,  0.0,  0,  channel,  0) ; 
state [channel]  ;=  idle; 

END; 

if  plot__switch  then  plot_initialize; 

REPEAT 

current_event  ; =  base  * . f ptr ; 

WITH  current_event*  DO 
CASE  kind  OF 
arrival : 

BEGIN 

num_of_arv[station_no]  ;=  num_of_arv[station_no]  +  1; 
generate_event (arrival,  time,  arrival_time,  trial_no,  channel_no, 

station_no) ; 

generate_event (transmission,  time,  arrival_time,  trial_no, 
channel_no,  station_no) ; 

END; 

transmission,  re_transmission: 

BEGIN 

trial_no  ;=  trial_no  +  l; 

CASE  state [channel_no]  OF 

idle:  state [channel_no]  ;=  busy; 
busy:  state [channel_no]  :=  collision; 
collision:  state [channel_no]  :=  collision; 

END;  {  case  } 

generate_event (resolution,  time,  arrival_time,  trial_no,  chan- 
nel_no,  station_no) ; 

END; 

resolution: 

BEGIN 

IF  state [channel_no]  =  collision 
THEN  BEGIN 
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generate_event (re_transinission,  time,  arrival_time,  trial_no, 
channel__no,  station_no)  ; 

END 

ELSE  BEGIN 

generate_event (departure,  time,  arrival_time,  trial_no, 
channel_no,  station_no) ; 

END; 

END; 

departure ; 

BEGIN 

num_of_depart [station_no]  :=  num_of_depart [station_no]  +  l; 
service_time  :=  current_event" . time  -  current_event" . arrival_time 
average_delay [station_no]  ;=  average_delay [station_no]  +  service_ 

time; 

variance_delay [station_no]  :=  variance_delay [station_no] 

+  service_time  *  service_time ; 
if  (num_of_depart [station_no]  mod  plot_interval)  =  0  then 
BEGIN 

writeln(delay_file,  current_event " .time: 10; 3 , 

average_delay [ station_no] /num_of_depart [ station_no ] : 10 : 5 ) ; 
writeln(throughput_f ile,  current_event “ .time: 10 : 3 , 

num_of_depart [ station_no ] /current_event “ . time : 1 0 : 5 ) ; 
writeln(text_file,  current_event * .time; 10:3, 

average_delay [ station_no ] /num_of_depart [ stat ion_no ] ; 2  0 ; 5 , 
num_of_depart [ station_no ] /current_event  * . time ; 18 : 5 ) ; 
if  plot_switch  then 
BEGIN 

reset (plot_f ile,  plot_disk_file) ; 
case  plot  of 
delay_curve : 

writeln(plot_file,  current_event * .time: 10: 3 , 
average_delay [ station_no ] /num- 
_of_depart[station_no] ;10;5) ; 

throughput ; 

writeln(plot_file,  current_event* .time: 10: 3 , 

num_of_depart [ stat ion_no ] /current_event  * . time : 10 : 5 ) ; 
END;  {  END  case  } 
close (plot_f ile) ; 
plot_graph(plot_disk_file) ; 

END; 

END; 

END; 

END_of_slot : 

BEGIN 

state[channel_no]  :=  idle; 

generate_event (END_of_slot,  time,  arrival_time,  trial_no,  chan- 
nel_no,  station_no) ; 

if  ( ( (trunc(current_event‘.time)  mod  dot_display_freq)  *  0) 
and  (not  plot_switch) )  then  write('.'); 

END; 

END; 

base  * . f ptr  : =  current_event ' . f ptr ; 
current_event  * . f ptr  * . bptr  ; =  base ; 
backlog  ;=  current_event* . trial_no; 
dispose (current_event) ; 
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UNTIL  ( (base" . fptr* .time  >=  max_time)  or  (backlog  >=  trial_max) ) ; 

if  plot_switch  then  graph_close; 

close (delay_file) ; 
close (throughput_file) ; 
close (queue_file) ; 

{  collect  statistics  } 
writeln(text_file) ; 

writeln(text_file,  'Final  Statistics:'); 
wr iteln ( text_f ile ,  ' ================= ' ) ; 

writeln(text_file, '  Maximum  simulation  slots:  ',  max_time: 10:2) ; 
wr iteln (text_f ile, '  Number  of  Channels  channel_total : 5) ; 

writeln(text_file, '  Maximum  Retransmission  Delay  :  ', 

mean_time[re_transmission] : 8 : 2 ,  '  slots ' ) ; 
writeln(text_file, '  Average  arrival  rate  :',  mean_time[ arrival] : 10: 5, 

'  packets  per  slot ' ) ; 

writeln(text_f ile, '  Number  of  Delay 

(slots) ' )  ; 

wr iteln (text_f ile, '  Station  arrival  departure  average 

variance ' ) ; 

FOR  station  :*  1  TO  station_total  DO 
BEGIN 

IF  num_of_depart[ station]  =  0 

THEN  average_delay[ station]  :=  0.0 

ELSE  average_de lay [station]  :=  average_delay[ station] 

/  num_of_depart [station] ; 

IF  num_of_depart[ station]  <=  1 

THEN  variance_delay[ station)  :=  0.0 

ELSE  variance_delay [station]  :=  (variance_delay[ station] 

-  num_of_depart [station]  *  average_delay [station]  *  average_delay [sta¬ 
tion]  ) 

/  (num_of_depart[ station]  -  1) ; 

writeln(text_f ile,  station: 10, 

num_of_arv[ station] : 10,  num_of_depart[ station] : 10, 
average_delay[ station] :15:5,  variance_delay [station] :15:5) ; 

END; 

close (text_f ile) ; 

END. 
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[*************************  BIDLOOP. PAS  ***************************} 


program  bi_directional_loop_network( input,  output) ; 
{$!  sci-graf . inc} 


const 

station_max 
channel_max 
session_max 
queue_max 
f i 1 e_s i z e_max 
default_plot_interval 
dot_display_freq 
post_text_f ile 
plot_disk_f ile 
post_delay_f ile 
post_throughput_f ile 
post_queue_file 
input_network_f ile 


8; 

16; 

64; 

20; 

100; 

10; 

1000; 

' posttext . dat ' 
'plotfile.dat' 
'posdelay.dat' 
' posthrpt . dat ' 
' posqueue . dat • 
•bidloop.tdt • ; 


type 

strSO 

label_name 

plot_type 

node_number 

session_number 

channel_number 

event_kind 

link 

event 


packed  array[1..80]  of  char; 
string [80] ; 

(delay_curve,  throughput,  queue_size) ; 
0 . . station_max ; 

0 . . session_max ; 

0 . . channel_max ; 

(arrival,  rcvjpkt,  departure) ; 

“event; 

record 

fptr,  bptr  :  link; 
kind  ;  event_kind ; 
time  :  double; 
arrival_time  :  double; 
pkt_time  ;  double; 
node_no  ;  node_number; 
session_no  ;  session_number 
end; 


var 

origin,  session,  channel,  node,  next,  exp_seed 
pkt_length,  pkt_time,  max_pkt_time,  max_time,  service_time 
dummy,  f ixed_pkt_length 
current_event ,  base 

{  graphics  oriented  variables  ) 
network_file,  text_file 

plot_file,  delay_file,  throughput_file,  queue_file 
plot_yesno,  plot_int,  plot_session 
plot_channel ,  plot_interval 

plot_session_in,  plot_session_out,  plot_channel_in 

plot_channel_out 

plot_factor 

plot_switch 


integer ; 
double; 
double; 
link; 


text ; 
text ; 
integer ; 
integer; 
integer ; 
integer ; 
double; 
boolean; 
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plot 

namel,  naine2,  names,  name4,  names,  name6 


:  plot_type; 
:  strSO; 


{  session  oriented  variables  } 
session_total 
max_traffic 

num_of_arv,  num_of_depart 
mean^kt_length,  traffic_rqmt 
session_rqmt 

aver age_de lay,  variance_delay 
last_departure_time 
inter_departur e_t ime 


session_number ; 
double; 

array  [session_number]  of  longint; 
array [session_number]  of  double; 
array[session_number,l. .2]  of  node_number 
array  [session_number]  of  double; 
array  [session_number]  of  double; 
array  [session_number]  of  double; 


{  channel  oriented  variables  } 

channel_total  :  channel_number ; 

back_log  ;  array [channel_number]  of  integer; 

last_arrival_time,  wait_time,  capacity  :  array [channel_number]  of  double; 

route  ;  array [node_number, session_number]  of  channel_number 


{  node  oriented  variables  ) 

origin_no,  destination_no,  node_total  :  node_number; 

half  :  node_number; 

node_process_time  :  array [ node_number ]  of  double; 

link_matrix  ;  array[channel_number, 1. .2]  of  node_number; 

short_path  ;  array [node_number,node_number]  of  channel_number ; 

row,  column  ;  node_number; 

{  variables  for  random  number  generation  ) 

glinext,  glinextp  ;  integer; 

glma  •  array  [1..55]  of  double; 

{ 

the  network  is  characterized  by  three  matrices; 


1.  link_matrix 

from 


to 


capacity 


channel  number 


node  no  node  no 


bits/sec 


2 .  session  matrix 


session  number 


origin 


node  no 


destination 


node  no 


traffic_rqmt 


packets/ sec 


mean_pkt_length 


bits/packet 


3 .  rotuing_matrix 


node  number 


session  number 


node_process_time 


out_bound_queue  channel_number  seconds 


{$!  header. inc) 


function  ran3 (var  idum;  integer):  double; 
const 

=  4 . 0e6 ; 

=  1618033.0; 

=  0.0; 

=  2.5e-7;  (*  l/mbig  *) 


mbig 

mseed 

mz 

fac 

var 

i, ii,k 
mj  ,mk 


:  integer ; 
:  double ; 


begin 

if  (idum  <  0)  then 
begin 

mj  ;=  mseed+idum; 

if  mj>=0.0  then  mj  ;=  mj-mbig*trunc(mj/mbig) 

else  mj  ;=  mbig-abs (mj ) +mbig*trunc (abs (mj ) /mbig) ; 
glma[55]  ;=  m j ; 
mk  ;=  1; 

for  i  ;=  1  to  54  do 
begin 

ii  :=  21*i  mod  55; 
glma[ii]  :=  mk; 
mk  ; =  m j -mk ; 

if  (mk  <  mz)  then  mk  :=  mk+mbig; 
mj  ;=  glma[ii] 
end; 

for  k  ;=  1  to  4  do 
begin 

for  i  ;=  1  to  55  do 
begin 

glma[i]  ;=  glma[i]-glma[l+( (i+30)  mod  55)]; 
if  (glma[i]  <  mz)  then  glma[i]  :=  glma[i]+mbig 
end 

end; 

glinext  ;=  0; 
glinextp  ;=  31; 
idum  : »  1 
end; 

glinext  :=  glinext+1; 
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if  (glinext  =  56)  then  glinext  :=  1; 
glinextp  :=  glinextp+1; 
if  (glinextp  =  56)  then  glinextp  :=  1; 
mj  :=  gliaa[glinext] -glina[ glinextp ] ; 
if  (mj  <  mz)  then  mj  :=  mj+mbig; 
glma[ glinext]  ;=  mj; 
ran3  :=  mj*fac 
end; 


procedure  str_to_pack(  in_str  :  label_name; 

var  pack_str  :  strSO  ) ; 

var 

max_length,  element  ;  integer; 
begin 

max_length  :=  length (in_str) ; 
for  element  1  to  max_length  do 

pack_str[ element]  :=  in_str [ element ] ; 
pack_str[max_length+l]  :=  chr(O) ; 
end; 


procedure  plot_initialize; 
begin 

case  plot_int  of 

1  ;  plot  ;=  delay_curve; 

2  ;  plot  ;=  throughput; 

3  :  plot  ;=  queue_size; 

end; 

auto_select_display ; 
virtual_display (YES) ; 
hrange (max_time ,  0.0); 
case  plot  of 
delay_curve  ; 
begin 

str_to_pack( ' Delay  vs  Time',  namel) ; 
str_to__pack( 'Simulation  Time  (seconds) name2) 
str_to_pack (' Average  Delay  (seconds) ' ,name3) ; 
vrange(queue_max  *  max_pkt_tirae ,  0.0); 
end; 

throughput  : 
begin 

str_to__pack (' Throughput  vs  Time',  namel); 
str_to_pack( 'Simulation  Time  (seconds) ', name2) 
str_to_pack ( ' Average  Throughput ' , name3 ) ; 
vrange(1.0,  0.0); 
end; 

queue_size  : 
begin 

str_to_pack (' Queue  size  vs  Time',  namel); 
str_to_pack( 'Simulation  Time  (seconds) ' ,name2) 
str_to_pack (' Average  Queue  size' ,name3) ; 
vrange ( queue_max ,  0.0); 
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end; 

end;  {  end  case  } 
graph_type( ORDINARY) ; 
line_connect (NO) ; 
display_onscreen(YES) ; 

syinbols(DOT,  DOT,  DOT,  DOT,  DOT,  SQUARE); 
hlbl_prec(l) ; 
vlbl_prec(3) ; 
clear_display (NO,  YES) ; 

title (CENTER,  namel) ; 
haxis_lbl  (CENTER,  naine2)  ; 
vaxis_lbl ( CENTER ,  name3 ) ; 

display_window(643 ,  0,  900,  0) ; 
graph_init; 
end; 


procedure  plot_graph(disk_file  :  label_name) ; 
begin 

str_to_pack( ' ' , namel) ; 
str_to_pack ( ' ' , name2 ) ; 
str_to_pack( ' ' ,name3) ; 
str_to_pack ( ' ' , name4 ) ; 
str_tojpack( ' ' , names) ; 
str_to_pack(disk_file, names) ; 

plot_pairs (namel,  name2,  name3,  name4,  names,  names,  1) ; 
clear_display (NO,  NO) ; 
background (NO) ; 
end; 


function  expdev(var  idum;  integer;  session:  integer) ;  double; 
begin 

expdev  :=  -ln(  ran3(idum)  )/traffic_rqmt [session] ; 
end; 


procedure  inter_arrival_time  (var  next_arrival  :  double; 

session  :  integer) ; 

begin 

next_arrival  :=  expdev (exp_seed,  session) ; 
end; 


procedure  pkt_distribution(var  pkt_si2e:  double;  session:  integer) ; 
begin 

pkt_size  :=  mean_pkt_length [ session] ; 
end; 


procedure  generate_event  (evkind  :  event_kind; 
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current_tinie :  double ; 
arv_time  :  double ; 

pkt_len  :  double; 

node  ;  node_nuniber ; 

session  :  session_nuinber)  ; 

var 

event , new_event  :  link; 
out_bound_queue  :  channel_nuinber ; 
delay  ;  double; 

begin 

new(new_event) ; 
case  evkind  of 

arrival:  {  next  arrival  ) 
begin 

inter_arrival_time (delay,  session) ; 
arv_tiine  :=  current_tiine  +  delay; 
new_event* . time  :=  arv_time; 
end; 

departure : 
begin 

new_event* . time  :=  current_time  +  node_process_time[node] ; 
end; 

rcv_pkt ; 
begin 

out_bound_queue  ;=  route[node, session] ; 

new_event" . time  ;*  current_time  +  node_process_time[node] 

+  pkt_len  +  wait_time[out__bound_queue] ; 

end; 

end;  {  end  case  } 

with  new_event  *  do 
begin 

kind  :=  evkind; 
arrival_time  :=  arv_time; 
pkt_time  :=  pkt_len; 
node_no  : =  node ; 
session_no  :=  session; 
end;  {  with  } 
event  : =  base ; 
repeat 

event  :=  event ".bptr 
until  new_event* . time  >=  event". time; 
new_event " . f ptr  ; =  event " . f ptr ; 
new_event  * . bptr  ; =  event ; 
event " . f ptr " . bptr  : =  new_event ; 
event ".f ptr  ;=  new_event; 
end;  {  generate_event  } 

begin 

{  read  in  network  size  ) 

reset (network_file,  input_network_f ile) ; 
readln(network_file,  node_total) ; 
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{  read  in  ploting  switch  ) 

readln(network_f ile,  plot_session_in) ; 
readln(network_file,  plot_session_out) ; 
readln(network_file,  plot_channel_in) ; 
readln(network_f ile,  plot_channel_out) ; 
plot_session  :=  1; 
plot_channel  :=  1; 
plot  ;=  delay_curve; 
plot_switch  :=  TRUE; 

{  read  in  netowrk  matrices  } 
session  :=  1; 

for  row  :=  1  to  station_max  do  {  build  session  matrix  from  traffic  matrix 
for  column  :=  1  to  station_max  do  begin 

readln(network_file,  traffic_rqmt [session] ) ; 
if  ((  abs (traffic_rqmt[ session] )  >  l.Oe-6)  and 

(  row  <=  node_total  )  and  (  column  <=  node_total  )  )  then  begin 
session_rqmt [session, 1]  :=  row; 
session_rqmt[ session, 2]  :=  column; 

if  ( (plot_session_in  =  row)  and  (plot_session_out  =  column) ) 
then  plot_session  :=  session; 
mean_pkt_length[ session]  ;=  1.0; 
session  ;=  session  +  1; 
end; 
end; 

session_total  :=  session  -  1; 
channel_total  ;=  2  *  node_total; 

for  channel  :=  1  to  node_total  do  begin  {  build  link  matrix  ) 
readln ( network_f ile ,  capacity [ channel ] ) ; 

1 ink_matrix[ channel, 1]  :=  channel; 

link_matrix[ channel, 2]  :=  (channel  mod  node_total)  +  1; 
if  ( (plot_channel_in  =  1 ink_matrix[ channel , 1] )  and 
(plot_channel_out  =  1 ink_matrix[ channel , 2 ]) ) 
then  plot_channel  ;=  channel; 

end; 

{  read  in  dummy  entries  ) 

if  (node_total  <  station_max)  then 

for  channel  ;=  (node_total  +  1)  to  (channel_max  div  2)  do 
readln (network_f ile,  dummy) ; 

{  continue  to  build  link  matrix  ) 

for  channel  ;=  1  to  node_total  do  begin 

readln (network_f ile,  capacity [ channel+node_total ] ) ; 
link_matrix[channel+node_total , 1]  ;=  (channel  mod  node_total)  +  1; 
link_matrix(channel+node_total,2]  ;=  channel; 
if  ( (plot_channel_in  =  link_matrix[channel+node_total , 1] )  and 
(plot_channel_out  =  link_matrix[channel+node_totai , 2 ] ) ) 
then  plot_channel  ;=  channel+node_total ; 

end; 

{  read  in  dummy  entries  } 

if  (node_total  <  station_max)  then 

for  channel  :=  (node_total  +  1)  to  (channel_max  div  2)  do 
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readln(network_file,  dummy) ; 

{  build  shortest  path  matrix  ) 
half  :=  node_total  div  2; 
for  origin  :=  1  to  node_total  do 
for  next  ;=  1  to  node_total  do 
begin 

if  ( ( (node_total  +  origin  -  next)  mod  node_total)  >  half) 
then  short_path[ origin,  next]  :=  origin 
else  begin 

short_path[ origin,  next]  :=  origin  +  (node_total-l) ; 
if  (short_path[ origin,  next]  <=  node_total)  then 

short_path[ origin,  next]  :=  short_path[ origin, next]  +  node_to- 

tal ; 

end; 

end; 

for  node  :=  1  to  node_total  do  {  build  routing  matrix  for  biloop  only  ) 
begin 

node_process_time[node]  ;=  0.0; 
for  session  ;=  1  to  session_total  do 

route [node, session]  :=  short_path [ node, session_rqmt[ session, 2 ]] ; 

end; 

readln(network_file,  max_time) ; 
readln(network_file,  plot_int) ; 
readln(network_file,  plot_yesno) ; 

close (network_file) ; 

{  echo  the  three  matrices  } 

rewrite (text_file,  post_text_file) ; 

writeln(text_file,  ' Store-and-Forward  Network  -  Bi-Directional  Loop'); 
writeln(text_file) ; 
writeln(text_file,  'Input'); 
writeln (text_f ile,  '=====•); 
writeln(text_file,  '  Routing  Matrix  :*); 
for  node  :=  1  to  node_total  do  {  routing  matrix  } 
begin 

for  session  :=  1  to  session_total  do 

write (text_f ile,  route[node, session] : 3) ; 
writeln (text_f ile,  node_process_time[node] :10:5) ; 
end; 

writeln (text_f ile) ; 

writeln (text_f ile,  '  Session  Matrix  :'); 

for  session  :=  1  to  session_total  do  {  session  matrix  } 

writeln (text_f ile,  session_rqmt [session, 1] : 3 ,  session_rgmt [session, 2 ] : 3 , 
traffic_rqmt [session] :10;5,  mean_pkt_length[ session] :10:5) ; 
writeln (text_f ile) ; 

writeln (text_f ile,  '  Link  Matrix  :'); 

for  channel  :=  1  to  channel_total  do  {  link  matrix  ) 

writeln (text_f ile,  link_matrix[ channel , 1] ; 3 ,  link_matrix[ channel , 2 ] : 3 , 
capacity [ channel ] ; 10 : 5 ) ; 
writeln (text_f ile) ; 

writeln(text~file,  'Simulation  Results  of  Session' ,plot_session: 4) ; 
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writeln(text_f ile,  'Simulated  Time  Average  Delay  Throughput') 

{  initialize  variables  ) 
exp_seed  :=  -1; 

for  channel  :=  1  to  channel_total  do 
begin 

wait_t ime [ channel ]  : =  0 . 0 ; 
last_arr ival_t ime [ channel ]  : =  0 . 0 ; 
back_log[ channel]  :=  0; 
end; 

max_traffic  ;=  0.0; 

for  session  :=  1  to  session_total  do 
begin 

last_departure_time[ session]  :=  0.0; 
average_delay [session]  ;=  0.0; 
variance_delay[ session]  :=  0.0; 
num_of_arv[ session]  ;=  0; 
nvim_of_depart[  session]  :=  0; 
if  max_traffic  <=  traffic_rqmt[ session]  then 
max_traffic  :=  traffic_rqmt[ session] ; 

end; 

plot_f actor  :=  (max_traffic  *  max_time) 

/  (file_size_max  *  default_plot_interval) ; 
plot_interval  ;*  default_plot_interval ; 
if  plot_factor  >  1.0  then 

plot_interval  ;=  default_plot_inteirval  *  tininc(plot_f actor  +  1.0)  ; 

rewrite (delay_f ile,  post_delay_file) ; 
rewrite (throughput_f ile,  post_throughput_file) ; 
rewrite (queue_f ile,  post_queue_file) ; 
rewrite (plot_f ile,  plot_disk_file) ; 

case  plot_yesno  of 

1  ;  plot_switch  ;=  TRUE; 

0  :  plot_switch  ;=  FALSE; 
end;  {  end  case  } 

IF  plot_int  =  0  THEN  plot_switch  ;=  FALSE; 
if  (not  plot_switch)  then  writeln( 'Running. ..') ; 

{  create  an  empty  event  ring  } 
new (base) ; 
with  base"  do 
begin 

f ptr  : =  base ; 
bptr  : =  base ; 
time  :=  0.0 
end; 

(  generate  arrival  for  each  session  } 
max_pkt_time  :=  0.0; 
for  session  :=  1  to  session_total  do 
begin 

origin  session_rgmt[session, 1] ; 

channel  route [origin, session] ; 
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pkt_distribution(pkt_length,  session) ; 
pkt_time  ;=  pkt_length  /  capacity [ channel ] ; 
if  max_pkt_time  <=  pkt_tiine  then  max_pkt_tiine  :=  pkt_time; 
generate_event ( arrival ,  0.0,  0.0,  pkt_time,  origin,  session); 
end; 


if  plot_switch  then  plot_initialize; 


repeat 

current_event  ;=  base*.fptr; 
with  current_event *  do 
case  kind  of 
arrival : 
begin 

niini_of_arv[session_no]  :=  ntun_of_arv[session_no]  +  1; 
generate_event (arrival,  tine,  arrival_time,  pkt_time,  node_no, 

session_no) ; 

channel  : =  route [ node_no , session_no ] ; 
if  back_log[ channel]  =  0  then 
begin 

wait_time[ channel]  :=  0.0; 
last_arrival_time[ channel]  ;=  arrival_time; 
back_log[ channel]  :=  back_log[ channel]  +  1; 
end 
else 
begin 

wait__tiine[ channel]  :=  wait_time[ channel]  +  pkt_time 

-  (  arrival_tine  -  last_arrival__time[ channel]  )  ; 
last_arrival_tiine[ channel]  ;==  arrival_time; 
if  wait_time[ channel]  <=  o.O  then 
wait_t ime [ channel ]  : =  o . 0 ; 
back_log[ channel]  ;=back_log[ channel]  +  1; 
end; 

generate_event (rcv_pkt,  time,  arrival_time,  pkt_time,  node_no, 

session_no) ; 

if  ( (num_of_ai'v[plot_session]  mod  dot_display_freq  =  0) 
and  (not  plot_*?witch) )  then  write('.'); 

end; 

departure ; 
begin 

num_of_depart [session_no]  ;=  num_of_depart [session_no]  +  1; 
service_time  ;=  current_event‘ . time  -  current_event* .arrival_time 
average_delay[session_no]  ;*  average_delay [session_no]+service_- 

time; 


sion_no] ; 


variance_delay [session_no]  ;=  variance_delay [session_no] 

+  service_time  *  service_time; 
inter_departure_time[session_no]  ;=  current_event* . time 

-  last_departure_time[ses- 

last_departure_time[session_no]  ;=  current_event* . time; 


if  (num_of_depart[session__no]  mod  plot_interval)  =  0  then 
begin 

if  plot_session  =  session_no  then 
begin 
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writeln(delay_file,  current_event * .time: 10: 3 , 
average_delay [ session_no ] /num_of_depart [ session_no ] : 10 : 5 ) 
writeln(throughput_file,  current_event * .time: 10: 3 , 
num_of_depart [ session_no ] /num_of_arv [ session_no ] : 10 : 5 ) ; 
writeln ( text_f ile ,  current_event  * . time : 10 : 3 , 
average_delay [ session_no ] /nvun_of _depart [ session_no ] : 20 : 5 , 
num_of_depart[session_no]/num_of_arv[session_no] :18:5) ; 

end; 

if  plot_switch  then 
begin 

reset (plot_f ile,  plot_disk_f ile) ; 
case  plot  of 

delay_curve:  if  plot_session  =  session_no  then 
writeln (plot_f ile,  current_event‘ .time: 10:3, 
average_delay [ session_no] /num_of_depart [ ses- 

sion_no] : 10: 5) ; 

throughput:  if  plot_session  =  session_no  then 
writeln (plot_f ile,  current_event* .time: 10: 3 , 
num_of_depart [ session_no ] /num_of_arv [ ses- 

sion_no] : 10: 5) ; 

end;  {  end  case  } 
close (plot_f ile) ; 
plot_graph(plot_disk_file) ; 
end; 

end; 

end; 

rcv_pkt : 
begin 

channel  :=  route [node_no, session_no] ; 
back_log[ channel]  :=  back_log [ channel ]  -  1; 

if (num_of_depart [session_no]  mod  plot_interval)  =  0  then 
begin 

if  plot_channel  =  channel  then 

writeln (queue_f ile,  current_event ‘ .time: 10: 5, 

back_log[ channel] :5) ; 

if  plot_switch  then 
begin 

reset (plot_f ile,  plot_disk_file) ; 
if  plot  =  gueue_size  then 

if  plot_channel  =  channel  then 

writeln (plot_f ile,  current_event * .time: 10: 5, 
back_log[ channel] :5) ; 
close (plot_f ile) ; 
plot_graph(plot_disk_file) ; 
end; 
end; 

node  :=  1 ink_matrix[ channel, 2] ; 
if  node  =  session_rqmt[session_no,2] 
then 

{  final  destination  } 
begin 
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session_no) 


generate_event ( departure ,  time,  arrival_time,  pkt_time,  node, 

end 
else 

{  route  to  next  node  } 
begin 

channel  : =  route [ node , session_no ] ; 
if  back_log[ channel]  =  0  then 
begin 

wait_time[ channel]  :=  0.0; 
back_log[ channel]  :=  back_log[ channel]  +  1; 
last_arr ival_t ime [ channel ]  : =  time ; 
end 
else 
begin 

wait_time[ channel]  :=  wait_time[ channel]  +  pkt_time 

-  (  time  -  last_arrival_time[ channel]  ) ; 
last_arrival_time[ channel]  ;=  time; 
if  wait_time[ channel]  <=  0.0  then 
wait_time[ channel]  :=  0.0; 
back_log[ channel]  back_log[ channel]  +1; 

end; 

generate_event (rcv_pkt,  time,  arrival_time,  pkt_time,  node, 

session_no) ; 

end; 

end; 

end; 

base  * . f ptr  : =  current_event  * . f ptr ; 
current_event* . fptr" .bptr  :=  base; 
dispose (current^event) ; 
until  ( (base* . fptr* .time  >=  max_time) 

or  (back_log[plot_channel]  >=  queue_max) ) ; 

if  plot_switch  then  graph_close; 

close (delay_file) ; 
close (throughput_file) ; 
close (queue_file) ; 

(  collect  statistics  } 
writeln(text_file) ; 

writeln(text_file,  'Final  Statistics;'); 
writeln(text_file,  '=====:==========*=•) ; 

writeln(text_file, '  maximum  simulated  time:  ',  max_time: 10: 2 ,  '  seconds'); 
for  session  :=  1  to  session_total  do 

writeln(text_file, '  average  arrival  rate  of  session',  session:5,  '  is', 
traf fic_rqmt[ session ]: 10: 5,  '  packets  per  second'); 
writeln(text_file, '  number  of  delay 

(seconds) ' ) ; 

writeln(text_file, '  session  arrival  departure  average 

variance ' ) ; 

for  session  :=  1  to  session_total  do 
begin 

if  num_of_depart( session]  *  0 

then  average_delay[ session]  :=  0.0 


139 


else  average_delay [session]  :=  average_delay [session] 

/  num_of_depart[session] ; 

if  num_of_depart [session]  <=  1 

then  variance_delay [session]  :=  0.0 

else  variance_delay [session]  :=  (variance_delay [session] 

-  nuin_of_depart [session]  *  average_delay [session]  *  average_delay [ses¬ 
sion]  ) 

/  (num_of_depart[ session]  -  1) ; 

writeln(text_file,  session: 10, 

nuin_of_arv[ session]  :10,  nuin_of_depart [session]  :10, 
average_delay [session] :15:5,  variance_delay [session] ;15:5) ; 

end; 

close (text_file) ; 
end. 
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[***********iHfk***********ii  CSMA.PAS  **************************/ 

PROGRAM  carrier_sense_multiple_access  (input,  output) ; 

{$!  sci-graf . inc} 

CONST 

persistency 
exit_count 
channel_max 
station_inax 
f  i  1  e_s  i  z  e_inax 
default_plot_interval 
dot__display_freq 
post_text_file 
plot_disk_file 
post_delay_f ile 
post_throughput_f ile 
post_queue_file 
input_file 

TYPE 

strSO  =  packed  array[1..80]  of  char; 

label_naine  =  string[80]; 

plot_type  =  (delay_curve,  throughput,  queue_size) ; 

channel_nuinber  =  0 . .  channel_inax ; 
station_nuinber  =  0.  .station_max; 

event_kind  =  (arrival,  transmission,  re_arrival,  p_sensing, 

resolution,  departure,  end_of_slot) ; 
channel_state  =  (idle,  busy,  collision) ; 
link  =  ‘event; 

event  = 

RECORD 

fptr,  bptr  :  link; 
kind  :  event_kind ; 
time  :  double; 
arrival_time  ;  double ; 
channel_no  ;  channel_number; 
station_no  ;  station_number 
END; 


=  0.0; 

=  20; 

=  10; 

=  20; 

=  100; 

=  10; 

=  1000; 

=  ' posttext . dat ' 
=  'plotfile.dat' 
=  'posdelay.dat' 
=  ' posthrpt . dat ' 
=  ' posgueue . dat ' 
=  ' csma . tdt ' ; 


VAR 

user,  population,  packet_size,  busy_count,  backlog 

station,  channel,  uniform_seed,  exp_seed 

max_traffic,  max_time,  service_time,  offer_rate, 

count_rate,  prev_depart_time,  interdep_time, 

average_interdep ,  variance_interdep,  prev_arrive_time, 

interarv_time,  average_interarv, 

variance_interarv,  input_rate,  actual_time 

current_event ,  base 

event_index 

station_total 

channel  total 


integer; 
integer ; 


double ; 
link; 

event_kind ; 
station_number 
channel  number 


glinext,  glinextp  ;  integer; 

glma  :  ARRAY  [1..55]  OF  double; 
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prev_state,  curr_state  :  ARRAY  [channel_nuinber]  OF  chan- 

nel_state ; 

nxiin_of_arv,  n\iin_of_fresh,  num_of_depart  :  ARRAY  [station_number]  OF  longint 
mean_time  :  ARRAY  [event_kind]  OF  double; 

aver age_de lay,  variance_delay, 

throughputs,  variation_coef f  :  ARRAY  [station_nuinber]  OF  double; 


{  graphics  oriented  VARiables  ) 
configuration_file,  text_file 

plot_file,  delay_file,  throughput_f ile,  queue_file 

plot_yesno,  plot_int 

plot_channel ,  plot_interval 

plot_factor 

plot_switch 

plot 

namel,  name2,  names,  name4,  names,  names 


text ; 
text; 
integer ; 
integer ; 
double; 
boolean; 
plot_type; 
strSO ; 


{$!  header. inc} 


FUNCTION  ranS (VAR  idum;  integer):  double; 
CONST 

mbig  =  4.0e6; 

mseed  =  1618033.0; 


mz 

fac 

VAR 


0.0; 

2.5e-7;  (*  1/mbig  *) 


i,ii,jtc  :  integer; 

mj,mk  :  double; 


BEGIN 

IF  (idum  <  0)  THEN 
BEGIN 

mj  :=  mseed+idum; 

IF  mj>=0.0  THEN  mj  ;=  mj-mbig*trunc(mj/mbig) 

else  mj  :=  mbig-abs(mj)+mbig*trunc(abs(mj )/mbig) ; 
glma[55]  ;=  mj ; 
mk  :=  1; 

for  i  ;=  1  to  54  do 
BEGIN 

ii  ;=  21*i  mod  55; 
glma[ii]  :=  mk; 
mk  ;=  mj-mk; 

IF  (mk  <  mz)  THEN  mk  ;=  mk+mbig; 
mj  ;=  glma[ii] 

END; 

for  k  ;=  1  to  4  do 
BEGIN 

for  i  ;=  1  to  55  do 


BEGIN 

glma[i]  :=  glma[i]-glma[l+( (i+30)  mod  55)]; 

IF  (glma[i]  <  mz)  THEN  glma[i]  ;=  glma[i]+mbig 
END 

END; 

glinext  :=  0; 
glinextp  31; 
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idum  ;=  1 
END; 

glinext  :=  glinext+1; 

IF  (glinext  =  56)  THEN  glinext  :=  1; 
glinextp  :=  glinextp+1; 

IF  (glinextp  =  56)  THEN  glinextp  :=  1; 
mj  ;=  glina[glinext]-gl!na[glinextp] ; 

IF  (mj  <  mz)  THEN  mj  :=  mj+mbig; 
glma [ gl inext ]  : =  m j  ; 
ran3  :=  mj*fac 
END; 


PROCEDURE  str_to_pack(  in_str  :  label_name; 

VAR  pack_str  :  strSO  ) ; 

VAR 

niax_length,  element  ;  integer; 

BEGIN 

max_length  :=  length (in_str) ; 
for  element  :=  1  to  max_length  do 

pack_str[ element]  :=  in_str [element] ; 
pack_str[max_length+l]  ;=  chr(O) ; 

END; 


PROCEDURE  plot_initialize; 

BEGIN 

CASE  plot_int  of 

1  ;  plot  ;=  delay_curve; 

2  :  plot  :=  throughput; 

3  :  plot  ;=  gueue_slze; 

END; 

auto_select_display; 
virtual_display (YES) ; 
hrange(max_time/packet_size,  0.0) ; 

CASE  plot  of 
delay_curve  ; 

BEGIN 

str_to_pack (' Delay  vs  Time’,  namel) ; 
str_to_pack( 'Simulation  Time  (slots) ' ,name2) ; 
str_to_pack (' Average  Delay  (slots) ' ,name3) ; 
vrange(exit_count*1.0,  0.0); 

END; 

throughput  : 

BEGIN 

str_to_pack (' Throughput  vs  Time',  namel); 
str_to_pack( 'Simulation  Time  (slots) ' ,name2) ; 
str_to__pack ( 'Average  Throughput'  ,name3)  ; 
vrange(1.0,  0.0); 

END; 

gueue_size  ; 

BEGIN 

str_to__pack (' Queue  Size  vs  Time',  namel); 
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str_to_pack( 'Simulation  Time  (slots) ' ,name2) ; 
str_to_pack (' Average  Queue  Size* ,name3) ; 
vrange(exit_count*l. 0,  0.0); 

END; 

END;  {  END  CASE  ) 
graph_type (ORDINARY) ; 
line_connect (NO) ; 
display_onscreen(YES) ; 

symbols(DOT,  DOT,  DOT,  DOT,  DOT,  SQUARE); 
hlbl_prec(l) ; 
vlbl_prec(3) ; 
clear_display (NO,  YES) ; 

title(CENTER,  namel) ; 
haxis_lbl (CENTER,  name2) ; 
vaxis_lbl (CENTER,  name3) ; 

display_window(643 ,  0,  900,  0); 
graph_init; 

END; 


PROCEDURE  plot_graphMisk_file  ;  label_name)  ; 

BEGIN 

str__to jpack ( •  ' , namel)  ; 
str_to__pack  ( '  ' ,  name2 )  ; 
str_to_pack ( ' ' , name3 ) ; 
str__to_pack  ( '  ' ,  name4 )  ; 
str_to_pack ( ' ' , names ) ; 
str_to_pack(disk_file, names) ; 

pi ot_pairs (namel,  name2,  name3,  name4,  names,  names,  1) ; 
clear_display (NO,  NO) ; 
background (NO) ; 

END; 


FUNCTION  expdev(VAR  idum:  integer) ;  double; 
BEGIN 

expdev  : =  -In ( ran3 ( idum) ) /mean_time [ arrival ] 
END; 


PROCEDURE  collision_resolution(VAR  next_transmission_time:  double) ; 
BEGIN 

next_transmission_time  ;=  mean_time[re_ar rival]  *  ran3 (unIForm_seed) ; 
END; 


PROCEDURE  inter_arrival_time  (VAR  next_arrival :  double) ; 
BEGIN 

next_arrival  :*  expdev (exp_seed) ; 

END; 
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PROCEDURE  generate_event  (evkind  : 

current_tiine : 
arv_tiine  : 

channel  : 

station  : 

VAR 

event , new_event  :  1 ink ; 
delay  ;  double; 

BEGIN 

new(new_event) ; 

CASE  evkind  OF 

arrival:  {  next  arrival  } 

BEGIN 

inter_arrival_time (delay) ; 
arv_time  :=  current_tiiae  +  delay; 
new_event " . time  : =  arv_t ime ; 

END; 

re_arrival:  {  schedule  retransmission  time  } 

BEGIN 

collision_resolution (delay) ; 
new_event* . time  :=  current_time  +  delay; 

END; 

transmission:  {  time  to  next  edge+  ) 

BEGIN 

new_event" . time  :=  t rune ( cur rent_t ime)  +  1.1; 

END; 

resolution:  {  resolution  is  scheduled  within  the  last  slot  } 
BEGIN 

new_event* . time  :=  current_time  +  (packet_size  -  0.5); 
END; 

p_sensing  :  (  persist  on  sensing  at  next  edge  ) 

BEGIN 


event_kind ; 
double; 
double ; 

channel_number ; 
station_number) ; 


new_event' . time  :=  current_time  +  i.O; 

END; 

departure:  {  total  packet  transmission  time  is  one  time  unit  ) 
BEGIN 

new_event" . time  :=  current_time  +  0.4;  (depart  at  edge) 
END; 

end_of_slot;  {  update  channel  state  at  edge-  ) 

BEGIN 

new_event' .time  :=  trunc(current_time  +  1.5)  -  0.1; 

END; 

END;  {  END  CASE  ) 


WITH  new_event*  DO 
BEGIN 

kind  :  *=  evkind ; 
arrival_time  :=  arv_time; 
channel_no  : *  channel ; 
station_no  :*  station; 
END;  (  with  } 
event  : =  base ; 

REPEAT 

event  :=  event '.bptr 
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UNTIL  new_event* . time  >=  event ".time; 
new_event " . f ptr  ; =  event " . f ptr ; 
new_event " . bptr  : =  event ; 
event " . f ptr " . bptr  : =  new_event ; 
event " . f ptr  ; =  new_event ; 

END;  {  generate  event  } 


BEGIN  (*  main  program  *) 

plot  :=  delay_curve; 
plot_switch  :=  TRUE; 

reset (configuration_file,  input_file) ; 
readln(conf iguration_file,  population) ; 
readln(configuration_file,  channel_total) ; 
channel_total  ;=  1; 

FOR  user  :=  1  TO  station_max  DO 
BEGIN 

readln(conf iguration_file,  input_rate) ; 

mean_time[ arrival]  :=  mean_time[ arrival]  +  input_rate; 

END; 

readln(configuration_file,  max_time) ; 
readln(configuration_file,  plot_int) ; 
readln(configuration_file,  plot_yesno) ; 
readln(configuration__file,  mean_time[re_arrival] )  ; 
readln(configuration”file,  packet_si2e) ; 
close (configuration_file) ; 

mean_time[re_arrival]  :=  mean_time[re_arrival]  *  packet_size; 
mean_time[ arrival]  :=  mean_time[ arrival]  /  packet_size; 

{  initialize  VARiablea^} 
exp_seed  ;=  -1; 
uniform_seed  ;=  -1; 

station_total  ;=  1; 
backlog  : =  0 ; 

max_time  :=  max_time  *  packet_size; 

max_traffic  :=  mean_time [ arrival ] ; 
plot_factor  :=  (max_traffic  *  max_time) 

/  (file_size_max  *  default_plot_interval) ; 
plot_interval  :=  defaultjplot_interval ; 

IF  plot_f actor  >1.0  THEN 

plot_interval  ;=  default_plot_interval  *  trunc(plot_f actor  +  1.0); 

rewrite (delay_file,  post_delay_f ile) ; 
rewrite (throughput_file,  post_throughput_file) ; 
rewrite (queue_f ile,  post_queue_file) ; 
rewrite (plot_f ile,  plot_disk_file) ; 
rewrite (text_f ile,  post_text_file) ; 

writeln(text_file,  'Multiple  Access  Protocol  -  CSMA  (single  channel)'); 
writeln(text_file) ; 

writeln(text_f ile,  'Simulation  Results:'); 
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writeln(text_file,  'Simulated  Time  Average  Delay  Throughput*); 

CASE  plot_yesno  of 

1  :  plot_switch  ;=  TRUE; 

0  :  plot_switch  ;=  FALSE; 

END;  (  END  CASE  ) 

if  plot_int  =  0  THEN  plot_switch  :=  FALSE; 
if  (not  plot_switch)  then  writeln( 'Running. ; 

{  create  an  empty  event  ring  } 
new (base) ; 

WITH  base*  DO 
BEGIN 

fptr  :=  base; 
bptr  :=  base; 
time  ;=  0.0 
END; 

{  generate  arrival  at  each  station  } 
prev_depart_time  ;=  0.0; 
interdep_time  :=  0.0; 
average_interdep  :=  0.0; 
variance_interdep  : =  0.0; 

prev_arrive_time  ; =  0.0; 
interarv_time  ;=  0.0; 
average_interarv  ;=  0.0; 
var  iance__interarv ;  =  0.0; 

FOR  station  ;=  1  TO  station_total  DO 
BEGIN 

average_delay [station]  ;=  0.0; 
variance_delay[ station]  :=  o.O; 
num_of_airv[ station]  ;=  0; 
num_of _depart [ station ]  ; =  0 ; 
num_of_fresh[ station]  :=  0; 

FOR  channel  ;=  i  TO  channel_total  DO 

generate_event (arrival,  0.0,  0.0,  channel,  station) ; 

END; 

{  generate  initial  conditions  for  each  channel  } 

FOR  channel  :=  l  TO  channel_total  DO 
BEGIN 

generate_event (end_of_slot,  -0.1,  0.0,  channel,  0); 
prev_state[ channel]  :=  idle; 
curr_state[ channel]  ;=  idle; 
busy  count  ;=  0; 

END; 

IF  plot_switch  THEN  plot_initialize ; 

REPEAT 

current_event  :=  base*. fptr; 

WITH  current  event*  DO 
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CASE  kind  OF 


a  r r i va 1 ,  r e_ar r i va 1 : 

BEGIN 

num_of_arv[station_no]  :=  num_of_arv[station_no]  +  1; 
generate_event (transmission,  time,  arrival_time, 

channel_no,  station_no) ; 

IF  current_event* .kind  =  arrival 
THEN  BEGIN 

num_of_fresh[station_no]  :=  num_of_fresh[station_no]  +  1; 
generate_event( arrival,  time,  arrival_time, 

channel_no,  station_no) ; 

END; 

interarv_time  ;=  ( cur rent_event" .time  -  prev_arrive_time) 

/  packet_size; 

average_interarv  :=  average_interarv  +  interarv_time; 
variance_interarv  ;=  variance_interarv  +  inter- 
arv_time*interarv_time ; 

prev_arrive_time  :=  cur rent_event" .time; 

END;  (arrival,  re_arrival} 

transmission: 

BEGIN 

CASE  prev_state[channel_no]  OF 
idle:  BEGIN 

CASE  curr_state[channel_no]  OF 
idle:  BEGIN 

curr_state[channel_no]  :=  busy; 
busy_count  :=  packet_size; 

END; 

busy,  collision: 

curr_state[channel_no]  :=  collision; 

END;  (  CASE  ) 

generate_event (resolution,  time,  arrival_time, 

channel_no,  station_no) ; 

END;  {  idle  CASE  ) 
busy,  collision: 

IF  (  ran3 (unIForm_seed)  <  persistency  )  {  persist  } 

THEN  generate_event(p_sensing,  time,  arrival_time, 

channel_no,  station_no) 

ELSE  generate_event(re_ar rival,  time,  arrival_time, 

channel_no,  station_no) ; 

END;  (case) 

END;  (transmission) 


p_sensing: 

BEGIN 

CASE  prev_state[channel_no]  OF 
idle:  BEGIN 

CASE  curr_state[channel_no]  OF 
idle:  BEGIN 

curr_state [ channel_no ]  : =  busy ; 
busy_count  :=  packet_size; 

END; 
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busy,  collision: 

curr_state[channel_no]  ;=  collision; 
END;  (  CASE  } 


generate_event ( resolution , 
END;  {  idle  CASE  } 


time,  arrival_tiine, 
channel_no,  station_no) ; 


busy,  collision: 

generate_event (p_sensing, 

END;  {  CASE  } 

END;  {p-sensing} 


time,  arrival_time, 

channel_no,  station_no) ; 


resolution: 

BEGIN 

IF  curr_state[channel_no]  =  collision 

THEN  generate_event ( re_arrival ,  time  +  0.4,  arrival_time, 

channei_no,  station_no) 

ELSE  generate_event (departure,  time,  arrival_time, 

channel_no,  station_no) ; 

END;  {resolution} 


departure : 

BEGIN 

num_of_depart [station_no]  :=  num_of_depart [station_no]  +  1; 


rival_time) 


time ; 


service_time  :=  (cur rent_event* .time  -  current_event * . ar- 

/  packet_si2e; 

average_delay[station_no]  :=  average_delay [station_no]  +  service 

variance_delay [station_no]  :=  variance_delay [station_no] 

+  service  time  *  service  time; 


IF  (num_of_depart [station_no3  mod  plot_interval)  =  0  THEN 
BEGIN 

actual_time  :=  current_event‘ . time  /  packet_size; 
writeln(delay_f ile,  actual_time: 10:3, 

average_delay[station_no]/num_of_depart [station_no] ; 10: 5) 
writeln(throughput_file,  actual_time: 10: 3 , 

num_of_depart [station_no]/actual_time: 10 : 5) ; 
writeln(text_file,  actual_time: 10: 3 , 

average_delay [ station_no ] /num_of_depart [ stat ion_no ] : 2  0 : 5 , 
num_of_depart[station_no]/actual_time: 18 : 5) ; 

IF  plot_switch  THEN 
BEGIN 

reset (plot_f ile,  plot_disk_f ile) ; 

CASE  plot  of 
delay_curve: 

wr iteln ( plot_f ile ,  actual_t ime : 1 0 ; 3 , 
average_delay [ stat ion_no ] /num- 
pf_depart [station_no] :10:5) ; 

throughput ; 

writeln(plot_file,  actual_time; 10:3, 

num_of_depart[ stat ion_no]/actual_t ime: 10:5) ; 

END;  {  END  CASE  ) 
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close (plot_file) ; 
plot_graph(plot_disk_file) ; 

END; 

END; 

interdep_time  :=  ( cur rent_event* .time  -  prev_depart_time) 

/  packet_size; 

average_interdep  ;=  average_interdep  +  interdep_time; 
variance_interdep  ;=  variance_interdep  +  interdep_time*inter- 

dep_time; 

prev_depart_t ime  : =  current_event “ . time ; 
offer_rate  ;=  num_of_arv[station_no]/average_interarv; 

count_rate  :=  num_of_arv[station_no]  *  packet_size 

/  cur r ent_event “ . t ime ; 

FOR  station  :=  1  TO  station_total  DO 
BEGIN 

throughputs [station]  :=  num_of_depart[ station ]/average_interdep 
IF  num_of_depart[ station]  <=  1 
THEN  variation_coeff [station]  :=  1.0 

ELSE  variation_coeff[ station]  :=  throughputs [station]  *  through 

puts [station] 

*  (variance_interdep  -  average_interdep*average_interdep 
/num_of _depart [ station ] )  /  ( num_of _depart [ station ]  -  1 ) ; 

backlog  ;=  num_of_fresh[ station]  -  num_of_depart [ station ] ; 

END; 

END ;  { departure ) 

end_of_slot: 

BEGIN 

prev_state[channel__no]  :=  curr_state[channel_no] ; 

CASE  curr_state[channel_no]  OF 
idle  :  busy_count  ;=  0; 
busy,  collision  : 

BEGIN 

IF  busy_count>0  THEN 
busy_count  ;=  busy_count  -  1; 

IF  (busy_count  =  0)  THEN 
curr_state[channel_no]  :=  idle; 

END; 

END;  {  CASE  } 

generate_event (end_of_slot,  time,  arrival__time, 

channel_no,  station_no) ; 

if  ( ( (trunc(current_event* .time)  mod  (dot_display_freq 

*  packet_size) )  =  0)  and  (not  plot_switch) )  then  write('.'); 
END ;  { end_of_slot ) 

END;  {CASE  kind  OF) 

base'.fptr  :=  current_event' . fptr ;  (*  remove  executed  event  *) 
current_event'' .  fptr*  .bptr  :=  base;  (*  from  ring  *) 

dispose  (current_event) ;  (*  from  memory  *) 

UNTIL  (base* . fptr“ .time  >=  max_time)  OR  (backlog  >=  exit_count) ; 

IF  plot_switch  THEN  graph_close; 
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close (delay_file) ; 
close (throughput_file) ; 
close (queue_file) ; 

{  collect  statistics  } 
writeln(text_file) ; 

writeln(text_file,  'Final  Statistics:'); 
writeln ( text_f ile ,  ' ================= • ) ; 

writeln(text_file, '  Maximum  simulation  slots:  max_time/packet_size: 10:2) 

writeln (text_f ile, '  Number  of  Channels  channel_total:5) ; 
writeln (text_f ile, '  Maximum  Retransmission  Delay  :', 

mean_time[re_arrival]/packet_size: 8 : 2 ,  '  slots'); 
writeln (text_f ile, '  Propagation  Ratio  :  ',  packet_size: 10) ; 
writeln (text_f ile, '  Average  arrival  rate  :', 

mean_time[arrival] *packet_size: 10: 5,  '  packets  per  slot'); 
writeln (text_f ile, '  Number  of  Delay 

(slots) ' )  ; 

writeln (text_f ile, '  Station  arrival  departure  average 

variance ' ) ; 

FOR  station  :=  1  TO  station_total  DO 
BEGIN 

IF  num_of_depart [Station]  =  0 
THEN  average_delay [station]  :=  0.0 

ELSE  average_delay [station]  :=  average_delay [station] 

/  num_of_depart[ station] ; 

IF  num_of_depart[ station]  <=  1 
THEN  variance_delay [station]  :=  0.0 
ELSE  variance_delay [station]  := 

(variance_delay [station]  -  num_of_depart [station] 

*  average_delay [station]  *  average_delay [station] 
/  (num_of_depart[ station]  -  1) ; 
writeln (text_f ile,  station;10, 

num_of_fresh[ station] :10,  num_of_depart [station] : 10, 
average_delay[station] :15:5,  variance_delay [station] : 15 : 5) ; 

END; 

close (text_f ile) ; 

END. 


151 


/It**************************  PLTDELAY. C  *****************11*********/ 


# include  <stdio.h> 

# include  <string.h> 

linclude  "sci-graf .h”  /*  header  file  defining  sci-graf  constants  */ 

main ( ) 

{ 

int  count ,  dev ; 

double  xmin,  xmax,  ymin,  ymax;  /*  variables  used  in  get_pair_info  below  * 

FILE  *stream; 

char  line[10],  *result; 

stream  =  fopenC'posttext.dat” ,  "r")  ; 
result  =  fgets(line,  10,  stream); 

auto_select_display ( ) ; 
virtual_display (YES) ; 

get_pair_info (''posdelay.dat ,  &count,  &xmin,  &xmax,  Symin,  &ymax)  ; 

hrange (0.0,  xmax) ; 

vrange(ymin,  ymax) ; 

graph_type (ORDINARY) ; 

line_connect (NO) ; 

display_onscreen(YES) ; 

symbols (SQUARE,  DOT,  DOT,  DOT,  DOT,  DOT); 
title ("Average  Delay  vs  Time",  CENTER); 

if  (strcmp(line, "Store-and") )  { 

haxis_lbl ("Simulation  Time  (slots)",  CENTER); 
vaxis_lbl ("Average  Delay  (slots)",  CENTER); 

} 

else  { 

haxis_lbl ("Simulation  Time  (seconds)",  CENTER); 
vaxis_lbl ("Average  Delay  (seconds)",  CENTER); 

) 

hlbl_prec(l) ; 
vlbl_prec(3) ; 

display_window(0, 900, 0,643) ; 
graph_init ( ) ; 

plot_pairs(l,  "posdelay.dat") ; 
graph_close ( ) ; 

} 
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/***************************  PLTTHRPT.C  *******************************/ 


# include  <stdio.h> 

# include  <string.h> 

linclude  "sci-graf .h”  /*  header  file  defining  sci-graf  constants  */ 

main ( ) 

{ 

int  count ,  dev ; 

double  xmin,  xmax,  ymin,  ymax;  /*  variables  used  in  get_pair_info  below  * 

FILE  *stream; 

char  line[10],  *result; 

stream  =  f open ( "posttext. dat” , ''r”)  ; 
result  =  fgets(line,  10,  stream) ; 

auto_select_display 0 ; 
virtual_display (YES) ; 

get_pair_info( "posthrpt.dat",  &count,  &xmin,  &xmax,  &ymin,  &ymax) ; 

hr ange (0.0,  xmax ) ; 

vrange(ymin,  ymax) ; 

graph_type (ORDINARY) ; 

line_connect (NO) ; 

display_onscreen(YES) ; 

symbols (SQUARE,  DOT,  DOT,  DOT,  DOT,  DOT); 
title ( "Average  Throughput  vs  Time" ,  CENTER) ; 

if  (strcmp(line, "Store-and") )  { 

haxis_lbl ("Simulation  Time  (slots)",  CENTER); 
vaxis_lbl ("Average  Throughput",  CENTER); 

} 

else  { 

haxis_lbl ("Simulation  Time  (seconds)",  CENTER); 
vaxis_lbl ("Average  Throughput",  CENTER); 

) 

hlbl_prec(l) ; 
vlbl_prec(5)  ; 

display_window(0, 900, 0, 643) ; 
graph_init ( ) ; 

plot_pairs(l,  "posthrpt.dat") ; 
graph_close ( ) ; 

} 
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{ **************-11*********  STARNET.PAS  ****************************} 

program  star_network( input,  output) ; 

{$!  sci-graf . inc} 


const 

station_max 
channel_max 
sesslon_max 
queue_max 
f ile_size_max 
default_plot_interval 
do t_d isplay_freq 
post_text_file 
plot_disk_file 
post_delay_f ile 
post_throughput_f ile 
post_queue_file 
input_network  file 


8; 

16; 

64; 

20; 

100; 

10; 

1000; 

' posttext . dat ' 
'plotfile.dat' 
•posdelay.dat' 
' posthrpt . dat ' 
' posqueue . dat • 
' starnet . tdt ' ; 


type 

strSO 

label_name 

plot_type 

node^number 

session_number 

channel_number 

event_kind 

link 

event 


packed  array [ 1 . . 8  0 ]  of  char ; 
string [80] ; 

(delay  curve,  throughput,  queue_si2e) ; 
0 . .  station__max ; 

0 . . session_max ; 

0 . . channel_max ; 

(arrival,  rcvjpkt,  departure) ; 

" event ; 

record 

fptr,  bptr  :  link; 
kind  :  event_kind ; 
time  :  double; 
arrival_time  :  double; 
pkt_time  :  double; 
node_no  :  node_number ; 
session_no  ;  session_number 
end; 


var 

origin,  session,  channel,  node,  exp_seed 

pkt_length,  pkt_time,  max_pkt_time,  max_time,  service_time 
dummy,  fixed_pkt_length 
current_event ,  base 


integer ; 
double ; 
double ; 
link; 


{  graphics  oriented  variables  } 
network_file,  text_file 

plot_file,  delay_file,  throughput_file,  queue_file 
plot_yesno,  plot_int,  plot_session 
plot_channel ,  plot_interval 

plot_session_in,  plot_session_out,  plot_channel_in 

p 1 o t_channe l_ou t 

plot_factor 

plot_switch 


text; 
text ; 
integer ; 
integer ; 
integer ; 
integer ; 
double; 
boolean; 
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plot 

namel,  naine2,  names,  name4,  names,  names 


:  plot_type; 
:  strSO; 


{  session  oriented  variables  } 
session_total 
max_traf fic 

num_of_arv,  num_of_depart 
mean_pkt_length,  traffic_rqmt 
session_rqmt 

average_delay,  variance_delay 
1 ast_departur e_t ime 
inter_departure_time 


session_number ; 
double ; 

array  [session_number]  of  longint; 
array [session_number]  of  double; 
array[session_number, 1. .2]  of  node_number 
array  [session_number]  of  double; 
array  [session_number]  of  double; 
array  [session_number]  of  double; 


{  channel  oriented  variables  } 

channel_total  ;  channel_number ; 

back_log  :  array Cchannel_number]  of  integer; 

last_arrival_time,  wait_time,  capacity  :  array [channel_number]  of  double; 

route  :  array [node_number, session_number]  of  channel_number 


{  node  oriented  variables  } 

origin_no,  destination_no,  node_total  :  node_number; 

node_process_time  :  array [node_number]  of  double; 

link_matrix  :  array[channel_number, 1. . 2 ]  of  node_number; 

row,  column  :  node  number; 


{  variables  for  random  number  generation  } 
glinext,  glinextp  :  integer; 

glma  :  array  [1..55]  of  double; 


{ 

the  network  is  characterized  by  three  matrices 
1.  link  matrix 


channel  nuiober 


from  to 


node  no  node  no 


capacity 


bits/sec 


2 .  session  matrix 


session  number 


origin 


node  no 


destination 


node  no 


traf fic_rqmt 


packets/ sec 


mean_pkt_length 


bits/packet 


3 .  rotuing_matrix 


session  number 


node_process_time 
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node  number 


seconds 


out_bound_queue  channel_number 


} 


{$I  header. Inc} 


function  ran3  (var  idiom:  integer):  double; 
const 
mbig 
mseed 


mz 

fac 

var 

mj  ,mk 


=  4 . 0e6 ; 

=  1618033.0; 

=  0.0; 

=  2.5e-7;  (*  1/mbig  *) 

:  integer ; 

:  double; 


begin 

if  (idum  <  0)  then 
begin 

mj  :=  mseed+idum; 

if  mj>=0.0  then  mj  :=  mj-mbig*trunc(mj/mbig) 

else  mj  :=  mbig-abs(mj)+mbig*tjrunc(abs(mj)/mbig)  ; 
glma[55]  :=  m j ; 
mk  :=  1; 

for  i  :=  1  to  54  do 
begin 

ii  :=  21*i  mod  55; 
glma[ii]  :=  mk; 
mk  :*  mj-mk; 

if  (mk  <  mz)  then  mk  :=  mk+mbig; 
mj  :=  glma[ii] 
end; 

for  k  :=  1  to  4  do 
begin 

for  i  :=  1  to  55  do 
begin 

glma[i]  :*  glma[i]-glma[l+( (i+30)  nod  55)]; 
if  (glma[i]  <  mz)  then  glma[i]  :=  glma[i]+mbig 
end 

end; 

glinext  :=  0; 
glinextp  :=  31; 
idum  :=  1 
end; 

glinext  :=  glinext+1; 

if  (glinext  *  56)  then  glinext  :=  1; 

glinextp  :=  glinextp+l; 
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if  (glinextp  =  56)  then  glinextp  :=  1; 
mj  :=  glina[glinext]-glina[glinextp] ; 
if  (mj  <  mz)  then  mj  ;=  mj+mbig; 
glma[glinext]  :=  m j ; 
ran3  :=  mj*fac 
end; 


procedure  str_to_pack(  in_str  :  label_name; 

var  pack_str  :  strSO  ) ; 

var 

max_length,  element  :  integer; 
begin 

max_length  :=  length (in_str) ; 
for  element  :=  1  to  max_length  do 

pack_str[ element]  :=  in_str [ element] ; 
pack_str [max_length+l]  :=  chr(O) ; 
end; 


procedure  plot_initialize; 
begin 

case  plot_int  of 

1  ;  plot  !=  delay_curve; 

2  ;  plot  ;=  throughput; 

3  ;  plot  :=  gueue_size; 

end; 

auto_select_display ; 
virtual_display (YES) ; 
hr ange ( max_t ime ,  0.0); 
case  plot  of 
delay_curve  : 
begin 

str_to_pack( ' Delay  vs  Time',  namel) ; 
str_to_pack( 'Simulation  Time  (seconds) ' ,name2) ; 
str_to_pack( 'Average  Delay  (seconds) ' ,name3) ; 
vrange(queue_max  *  max_pkt_time,  0.0); 
end; 

throughput  : 
begin 

str_to_pack (' Throughput  vs  Time',  namel); 
str_to_pack( 'Simulation  Time  (seconds) ' ,name2) ; 
str_to_pack( 'Average  Throughput’ ,name3) ; 
vrange(1.0,  0.0); 
end; 

queue_size  : 
begin 

str_to_pack (' Queue  Size  vs  Time',  namel); 
str_to_pack( 'Simulation  Time  (seconds) ' ,name2) ; 
str_to_pack (' Average  Queue  Size ' , name3) ; 
vrange ( queue_max  *  1.0,  0.0); 
end; 

end;  {  end  case  } 
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graph_type (ORDINARY) ; 
line_connect (NO) ; 
display_onscreen(YES) ; 

symbols (DOT,  DOT,  DOT,  DOT,  DOT,  SQUARE); 
hlbljprec(l)  ; 
vlbl_prec ( 3 ) ; 
clear_display (NO,  YES) ; 

title (CENTER,  namel) ; 
haxis_lbl (CENTER,  name2) ; 
vaxis_lbl ( CENTER ,  name3 ) ; 

display_window(643 ,  0,  900,  0)  ; 
graph_init ; 
end; 


procedure  plot_graph(disk_file  ;  label_name) ; 
begin 

str__tojpack ( '  • , namel)  ; 
str_to_pack ( ' ' , name2 ) ; 
str_to_pack( ' ' ,name3) ; 
str_to_pack ( ' ' , name4 ) ; 
str__to_pack( '  '  ,name5)  ; 
str_tojpack(disk_file, names) ; 

plot_pairs( namel,  name2,  name3,  name4,  names,  names,  1) ; 
clear_display (NO,  NO) ; 
background (NO) ; 
end; 


function  expdev(var  idum;  integer;  session:  integer) :  double; 
begin 

expdev  ;=  -ln(  ran3(idum)  ) /traffic_rqmt[ session ] ; 
end; 


procedure  inter_arrival_time  (var  next_arrival  :  double; 

session  :  integer) ; 

begin 

next_arrival  ;=  expdev (exp_seed,  session) ; 
end; 


procedure  pkt_distribution(var  pkt_si2e:  double;  session:  integer) ; 
begin 

pkt_size  :=  mean_pkt_length [ session] ; 
end; 


procedure  generate_event  (evkind  :  event_kind; 

current_t ime :  douhl « ; 
arv  time  :  double; 
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pkt_len 
node 
session 

var 

event , new_event  ;  link; 
out_bound_queue  :  channel_number ; 
delay  :  double; 

begin 

new(new_event) ; 
case  evkind  of 

arrival:  {  next  arrival  } 
begin 

inter_arrival_time (delay,  session) ; 
arv_time  :=  current_time  +  delay; 
new_event  * . time  ; =  arv_t ime ; 
end; 

departure : 
begin 

new_event" . time  :=  current_time  +  node_process_time[node] ; 
end; 

rcv_pkt : 
begin 

out_bound_queue  :=  route [node, session] ; 

new_event  * . time  : =  current_time  +  node_process_t ime [ node ] 

+  pkt_len  +  wait_time[out_bound_queue] ; 
end;  ” 

end;  {  end  case  ) 

with  new_event'  do 
begin 

kind  : =  evkind ; 
arrival_time  :=  arv_time; 
pkt_time  ;=  pkt_len; 
node_no  : =  node ; 
session_no  :=  session; 
end;  (  with  ) 
event  :=  base; 
repeat 

event  : =  event ' . bptr 
until  new_event‘ . time  >=  event ‘.time; 
new_event  * . f ptr  : =  event ‘ . f ptr ; 
new_event ‘ . bptr  : =  event ; 
event ‘ . f ptr ‘ . bptr  ; =  new_event ; 
event ‘ . f ptr  ; =  new_event ; 
end;  {  generate_event  } 


begin 

(  read  in  network  size  } 

reset (network_file,  input_network_f ile) ; 
readln(network_f ile,  node_total) ; 

(  read  in  ploting  switch  ) 


:  double ; 

:  node_number ; 

;  session_number) ; 
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readln ( network_f ile , 
readln ( network_f ile , 
readln (network_f ile, 
readln ( network_f ile , 
plot_session  :=  1; 
plot_channel  : *  1 ; 
plot  :=  delay_curve; 
plot_switch  :=  TRUE; 


plot_session_in) ; 
plot_session_out) ; 
plot_channel_in) ; 
plot_channel_out) ; 


{  read  in  netowrk  matrices  } 
session  :=  1; 

for  row  :=  1  to  station_max  do  {  build  session  matrix  from  traffic  matrix 
for  column  :=  1  to  station_max  do  begin 

readln (network_f ile,  traffic_rqmt [session ] ) ; 
if  (  (abs(traffic_rqmt [session] )  >  l.Oe-6  )  and 

(column  <=  node_total)  and  (row  <=  node_total)  )  then  begin 
session_rqmt [ session, 1]  :=  row; 
session_rqmt[ session, 2]  :=  column; 

if  ( (plot_session_in  *  row)  and  (plot_session_out  =  column) ) 
then  plot_sesslon  :=  session; 
mean_pkt_length[ session]  :=  1.0; 
session  :=  session  +  1; 
end; 
end; 

session  total  ;=  session  -  1; 


channel_total  :=  2  *  (  node_total-l  ) ; 

for  channel  ;=  1  to  (node_total-l)  do  begin  {  build  link  matrix  ) 
readln (network_f ile,  capacity [channel] ) ; 

1 ink_matrix[ channel, 1]  ;=  1; 
link_matrix[ channel, 2]  :=  channel+1; 
if  ( (plot_channel_in  =  1 ink_matrix[ channel, 1] )  and 
(plot_channel_out  =  link_matrix[channel,2] ) ) 
then  plot_channel  ;=  channel; 

end ; 


(  read  in  dummy  entries  } 

for  channel  :=  node_total  to  (channel_max  div  2)  do 
readln (network_f ile,  dummy) ; 

{  continue  to  build  link  matrix  } 

for  channel  :=  node^total  to  channel_total  do  begin 
readln (network_f ile,  capacity [ channel ] ) ; 
link_matrix[ channel, 2]  ;=  1; 

1 ink_matrix[ channel, 1]  ;=  channel  -  node_total+2 ; 
if  ( (plot_channel_in  *  1 ink_matrix[ channel, 1] )  and 
(plot”channel_out  =  link_matrix[ channel , 2 ] ) ) 
then  plot_channel  ;=  channel; 

end; 

{  read  in  dummy  entries  } 

for  channel  :=  node_total  to  (channel_max  div  2)  do 
readln (network_f ile,  dummy) ; 

for  node  :*  2  to  node_total  do  {  build  routing  matrix  for  star  only  ) 
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begin 

node_process_time[node]  :=  0.0; 
for  session  ;=  1  to  session_total  do 

route [node, session]  :=  node  +  node_total  -2; 

end; 

node_process_tiine[l]  ;=  0.0; 

for  session  :=  1  to  sesslon_total  do 

route[l, session]  :=  session_rqint [session, 2 ] -1; 

readln(network_f lie,  max_time) ; 
readln(network_file,  plot_int) ; 
readln(network_file,  plot_yesno) ; 

close (network_f lie) ; 

{  echo  the  three  matrices  } 

rewrite (text_f lie,  post_text_file) ; 

writeln(text_f lie,  ' Store-and-Forward  Network  -  Star  Topology'); 
writeln(text_f lie) ; 
writeln(text_f lie,  'Input'); 
writeln(text_file,  •=*==='); 
writeln(text_file,  '  Routing  Matrix  :'); 
for  node  ;=  1  to  node_total  do  {  routing  matrix  } 
begin 

for  session  ;=  1  to  session_total  do 

write ( text_f ile ,  route [ node , session ] ; 3 ) ; 
writeln(text_file,  nodejprocess_time[node] ; 10: 5) ; 
end; 

writeln(text_file) ; 

writeln(text_file,  '  Session  Matrix  :'); 

for  session  ;=  1  to  session_total  do  {  session  matrix  ) 

writeln(text_file,  session_rqmt [ session, 1] :3,  session_rqmt [session, 2] :3, 
traffic_rqmt[ session] :10:5,  mean_pkt_length[ session] :10:5) ; 
writeln(text_f ile) ; 

writeln(text_file,  '  Link  Matrix  ;'); 

for  channel  ;=  1  to  channel_total  do  (  link  matrix  ) 

writeln(text_file,  link_matrix[channel, i] :3,  1 ink_matrix[ channel , 2 ] :3, 
capacity [ channel ]: 10:5) ; 
writeln(text_file) ; 

writeln(text_f ile,  'Simulation  Results  of  Session' ,plot_session: 4) ; 
writeln(text_file,  'Simulated  Time  Average  Delay  Throughput'); 

(  initialize  variables  } 
exp_seed  :=  -1; 

for  channel  :=  1  to  channel_total  do 
begin 

wait_time[ channel]  :=  0.0; 
last_arrival_time[ channel]  :=  0.0; 
back_log[ channel]  :=  0; 
end; 

max_traffic  :=  0.0; 
for  session  :=  1  to  session_total  do 
begin 

last_departure_time[ session]  :=  0.0; 
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average_delay[ session]  :=  0.0; 
variance_delay[ session]  :=  0.0; 
num_of_arv[ session]  :=  0; 
num_of_depart[ session]  :=  0; 
if  inax_traffic  <=  traffic_rcpnt[ session]  then 
inax_traffic  :=  traffic_rqint [session] ; 

end; 

plot_f actor  :=  (max_traffic  *  max_tiine) 

/  (file_size_max  *  default_plot_interval) ; 
plot_interval  :=  def ault_plot_interval ; 
if  plot_f actor  >  1.0  then 

plot_interval  :=  default_plot_interval  *  trunc (plot_f actor  +  1.0); 

rewrite (delay_file,  post_delay_f ile) ; 
rewrite (throughput_file,  post_throughput_file) ; 
rewrite (queue_f ile,  post_queue_f ile) ; 
rewrite (plot_f ile,  plot_disk_f ile) ; 

case  plot_yesno  of 

1  :  plot_switch  :=  TRUE; 

0  :  plot_switch  :=  FALSE; 
end;  {  end  case  ) 

IF  plot_int  =  0  THEN  plot_switch  :=  FALSE; 
if  (not  plot_switch)  then  writeln( 'Running. ..') ; 

{  create  an  empty  event  ring  ) 
new (base) ; 
with  base*  do 
begin 

fptr  ;=  base; 
bptr  : =  base ; 
time  :=  0.0 
end; 

{  generate  arrival  for  each  session  ) 
max_pkt_time  ; =  0.0; 
for  session  ;=  1  to  session_total  do 
begin 

origin  :=  session_rqmt [session,  1] ; 
channel  :=  route [origin, session] ; 
pkt_distribution(pkt_length,  session) ; 
pkt_time  ;=  pkt_length  /  capacity [ channel ] ; 
if  max_pkt_time  <=  pkt_time  then  max_jpkt_time  :=  pkt_time; 
generate_event (arrival,  0.0,  0.0,  pkt_time,  origin,  session); 
end; 

if  plot_switch  then  plot_initialize; 
repeat 

current_event  : =  base  * . fptr ; 
with  current_event*  do 
case  kind  of 
arrival ; 
begin 

num_of_arv[session_no]  ;=  num_of_arv[session_no]  +  1; 
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generate_event (arrival,  time,  arrival_time,  pkt_time,  node_no, 

session_no) ; 

channel  :=  route[node_no, session_no] ; 
if  back_log[ channel]  =  0  then 
begin 

wait_time[ channel]  :=  0.0; 

last_arrival_time[ channel]  ;=  arrival_time; 
back_log[ channel]  :=  back_log[ channel]  +  1; 
end 
else 
begin 

wait_time[ channel]  :=  wait_time[ channel]  +  pkt_time 

-  (  arrival_time  -  last_arrival_time[ channel]  ) ; 
last_arrival_time[ channel]  :=  arrival_time; 
if  wait_time[ channel]  <=  0.0  then 
wait_time[ channel]  :=  0.0; 
back_log[ channel]  :=back_log[ channel]  +  l; 
end; 

generate_event ( rcv_pkt ,  time,  arrival_time,  pkt_time,  node_no, 

session_no) ; 

if  ( (num_of_arv[plot_session]  mod  dot_display_freq  =  0) 
and  (not  plot_switch) )  then  write ( ' . ' ) ; 

end; 

departure : 
begin 

num_of_depart(session_no]  ;=  num_of_depart[session_no]  +  1; 
service_time  ;=  current_event* . time  -  current_event* .arrival_time 
average_delay[session_no]  :=  average_delay [session_no]+service_- 

time; 


sion_no] ; 


variance_delay[session_no]  :=  variance_delay [session_no] 

+  service_time  *  service_time; 
inter_departure_time[session_no]  ;=»  current_event* .  time 

-  last_departure_time[ses- 

last_departure_time[session_no]  :=  current_event" . time; 


if  (num_of_depart(session_no]  mod  plot_interval)  =  0  then 
begin 

if  plot_session  =  session_no  then 
begin 

writeln (delay_f ile,  current_event‘ . time: 10 : 3 , 
average_delay [session_no]/num_of_depart [session_no] : 10: 5) 
writeln (throughput_f ile ,  current_event ‘ . time : 10 : 3 , 
num_of_depart [session_no]/num_of_arv[session_no] :10:5) ; 
writeln (text_f ile,  current_event ‘ .time: 10: 3 , 
average_delay[session_no]/num_of_depart [session_no] : 20: 5, 
num_of_depart[session_no]/num_of_arv[session_no] :18:5) ; 

end; 

if  plot_switch  then 
begin 

reset (plot_f ile,  plot_disk_file) ; 
case  plot  of 

delay_curve;  if  plot_session  =  session_no  then 
writeln (plot_f ile,  current_event* .time: 10:3, 
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average_delay [ session_no]/num_of_depart [ ses- 

sion_no] ; 10; 5) ; 

throughput;  if  plot_session  =  session_no  then 
writeln(plot_file,  current_event * .time; 10; 3 , 
num_of_depart [ session_no ] /num_of_arv [ ses- 

sion_no] ; 10; 5) ; 

end;  {  end  case  } 
close (plot_file) ; 
plot_graph(plot_disk_file) ; 
end; 

end; 

end; 

rcv_pkt ; 
begin 

channel  ;=  route [node_no, session_no] ; 
back_log[ channel]  ;=  back_log[ channel]  -  1; 

if (num_of_depart[session_no]  mod  plot_interval)  =  0  then 
begin 

if  plot_channel  =  channel  then 

writeln ( queue_f ile ,  current_event * . time ; 10 ; 5 , 

back_log[ channel] ;5) ; 

if  plot_switch  then 
begin 

reset (plot_f ile,  plot_disk_file) ; 
if  plot  =  queue_size  then 

if  plot_channel  =  channel  then 

writeln (plot_f ile,  current_event* .time; 10; 5, 
back_log[ channel] ;5) ; 
close (plot_f ile) ; 
plot_graph(plot_disk_file) ; 
end; 
end; 

node  ; =  link_matrix [ channel , 2 ] ; 
if  node  =  session_rqmt[session_no,2] 
then 

{  final  destination  } 
begin 

generate_event (departure,  time,  arrival_time,  pkt_time, 

session_no) 

end 

else 

{  route  to  next  node  } 
begin 

channel  ;=  route[node,session_no] ; 
if  back_log[ channel]  *  0  then 
begin 

wait_time[ channel]  ;=  0.0; 
back_log[ channel]  ;=  back_log[ channel]  +  1; 
last_arrival_time[ channel]  ;=  time; 
end 
else 


node, 
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begin 

wait_tiine[ channel]  :=  wait_time[ channel]  +  pkt_time 

-  (  time  -  last_arrival_time[ channel]  ) ; 
last_arrival_time[ channel]  ;=  time; 
if  wait_time[ channel]  <=  0.0  then 
wait_time[ channel]  ;=  0.0; 
back_log[ channel]  :=  back_log[ channel]  +1; 
end; 

generate_event (rcv_pkt,  time,  arrival_time,  pkt_time,  node, 

session_no) ; 

end; 

end; 

end; 

base  * . f ptr  : =  current_event “ . f ptr ; 
current_event  * . f pt r  * . bptr  : =  base ; 
dispose (current_event) ; 
until  ( (base" . fptr“ .time  >=  max_time) 

or  (back_log[plot_session]  >=  queue_max) ) ; 

if  plot_switch  then  graph_close; 

close (delay_file) ; 
close (throughput_file) ; 
close (queue_file) ; 

{  collect  statistics  } 
writeln(text_file) ; 

writeln(text_file,  'Final  Statistics;'); 
writeln  (text_f  ile,  '  ==—=====“*====*  • ) ; 

writeln(text_file, '  maximum  simulation  time:  ',  max_time: 10 : 2 ,  '  seconds') 
for  session  ;=  1  to  session_total  do 

writeln (text_f ile, '  average  arrival  rate  of  session',  session;5,  '  is', 
traffic_rqmt [session] ; 10; 5,  '  packets  per  second'); 
writeln (text_f ile, '  number  of  delay 

(seconds) ' ) ; 

writeln(text_f ile, '  session  arrival  departure  average 

variance' ) ; 

for  session  :=  1  to  session_total  do 
begin 

if  num_of_depart[ session]  =  0 

then  average_delay [session]  ;=  0.0 

else  average_delay [session]  ;=  average_delay [session] 

/  num_of_depart [session] ; 

if  num_of_depart[ session]  <=  1 

then  variance_delay [session]  :=  0.0 

else  variance_delay [session]  ;=  (variance_delay [session] 

-  num_of_depart [session]  *  average_delay [session]  *  average_delay [ses¬ 
sion]  ) 

/  (num_of_depart [session]  -  1) ; 

writeln (text_f ile,  session: 10, 

num_of_arv[ session] ;10,  num_of_depart [session] :10, 
average_delay [session] ; 15: 5,  variance_delay[session] : 15: 5) ; 

end; 

close (text_f ile) ; 
end. 
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[*************************  TREE. PAS  *****************************} 


PROGRAM  tree_algorithm  (input,  output); 
{$!  sci-graf . inc} 


CONST 

channel  max 

station_max 

updown_max 

f i 1 e_s i 2  e_max 

default_plot_interval 

dot_display_freq 

post_text_file 

plot_disk_file 

post_delay_f ile 

post_throughput_f ile 

post_queue_file 

input_file 


10; 

20; 

10; 

100; 

10; 

1000; 

'posttext.dat' ; 
'plotfile.dat' ; 
'posdelay.dat* ; 
' posthrpt . dat ' ; 
*  posqueue . dat ' ; 
' tree . tdt ' ; 


TYPE 


strSO 

label_name 

plot_type 

channe l_number 

station_number 

updown_number 

event_kind 

coin 

channel_state 

link 

event 


packed  array[1..80]  of  char; 
string [80] ; 

(delay_curve,  throughput,  queue_size) ; 

0 . . channel_max ; 

0 . . station_max ; 

0 . . updown_max ; 

(arrival,  transmission,  wait_for_clear,  resolution, 
departure,  END_of_slot,  ck_glb_count ,  tx_after_blk) ; 
(head,  tail) ; 

(idle,  busy,  collision); 

‘event; 


RECORD 

fptr,  bptr  :  link; 
kind  ;  event_kind ; 
time  :  double; 
arrival_time  ;  double; 
updown_no  :  updown_number ; 
channel_no  ;  channel_number ; 
station_no  ;  station_number 
END; 


VAR 


num_of_arv,  num_of_depart  ;  ARRAY 

mean_time  ;  ARRAY 

global_count  ;  ARRAY 

state  :  ARRAY 

nel_state ; 

backlog,  user,  population,  station,  channel 
input_rate,  max_traffic,  max_time,  service_ 
average_delay,  variance_delay  :  ARRAY 

last_departure_time,  inter_departure_time  : 
double; 

cur rent_event, base  :  link; 

event  index  :  event 


[station_number]  OF  longint; 
[event_kind]  OF  double; 
[channel_number]  OF  integer; 

[ channe l_number]  OF  chan- 

,  coin_seed,  exp_seed  :  integer 
time  :  double ; 

[station_number]  OF  double; 
ARRAY  [station_number]  OF 


kind; 
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station_total 
channel_total 
coin_face 
glinext,  glinextp 
glma 


station_niimber ; 
channel_ntiinber ; 
coin; 
integer; 

ARRAY  [1..55]  OF  double; 


{  graphics  oriented  variables  } 

configuration_file,  text_file  :  text; 

plot_file,  delay_file,  throughput_file,  queue_file  ;  text; 

plot_yesno,  plot_int  ;  integer; 

plot_channel ,  plot_interval  ;  integer; 

plot_f actor  ;  double; 

plot_switch  :  boolean; 

plot  :  plot_type 

nanel,  naiae2,  names,  name4,  names,  names  :  strSO; 


{$!  header. inc} 


FUNCTION  ran 3 (VAR  idum:  integer):  double; 
const 

mbig  =  4 . 0e6 ; 

mseed  =  1618033.0; 

mz  =0.0; 

fac  =  2.5e-7;  (*  l/mbig  *) 


var 

i,ii,k  :  integer; 

m j , mk  :  double ; 


BEGIN 

if  (idum  <  0)  then 
BEGIN 

mj  :=  mseed+idum; 

if  mj>=0.0  then  mj  :=  mj-mbig*trunc(mj/mbig) 

else  mj  :=  mbig-abs(mj)+mbig*trunc(abs(mj)/mbig) ; 
glma [55]  :=  m j ; 
mk  : =  1 ; 

for  i  :=  1  to  54  do 
BEGIN 

ii  ;=  21*i  mod  55; 
glma[ii]  :=  mk; 
mk  :=  mj-mk; 

if  (mk  <  mz)  then  mk  ;=  mk+mbig; 
mj  :=  glma[ii] 

END; 

for  k  ;=  1  to  4  do 
BEGIN 

for  i  ;=  1  to  55  do 
BEGIN 

glma[i]  ;=  glma[i]-glma[l+( (i+30)  mod  55)]; 
if  (glma[i]  <  mz)  then  glma[i]  :=  glma[i]+mbig 
END 

END; 

glinext  ;=  0; 
glinextp  ;=  31; 
idxim  :  =  1 
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END; 

glinext  :=  glinext+1; 
if  (glinext  =  56)  then  glinext  :=  1; 
gl inextp  ; =  gl inextpt 1 ; 
if  (gl inextp  =  56)  then  gl inextp  :=  1; 
mj  ;=  glma [glinext]-glma[gl inextp ] ; 
if  (mj  <  mz)  then  mj  :=  mj+mbig; 
glma [glinext]  :=  mj; 
ran3  :=  mj*fac 
END; 


procedure  str_to_pack(  in_str  :  label_name; 

var  pack_str  ;  strSO  ) ; 

var 

max_length,  element  :  integer; 

BEGIN 

max_length  :=  length (in_str) ; 
for  element  :=  1  to  max_length  do 

pack_str( element]  :=  in_str [ element] ; 
pack_str [max_length+l]  :=  chr(O) ; 

END; 


procedure  plot_initialize; 

BEGIN 

case  plot_int  of 

1  ;  plot  :=  delay_curve; 

2  :  plot  :=  throughput; 

3  :  plot  :=  queue  size; 

END; 

auto_select_display ; 
virtual_display (YES) ; 
hr ange ( max_t ime ,  0.0); 
case  plot  of 
delay_curve  ; 

BEGIN 

str_to_pack( 'Delay  vs  Time',  namel) ; 
str_to_pack( 'Simulation  Time  (slots) ' ,name2) 
str_to_pack (' Average  Delay  (slots) ' ,name3) ; 
vrange ( updown_max* 1.0,  0.0); 

END; 

throughput  : 

BEGIN 

str_to_pack (' Throughput  vs  Time',  namel); 
str_to_pack( 'Simulation  Time  (slots) ' ,name2) 
str”to_pack ( ' Average  Throughput ' , name3 ) ; 
vrancre  (1.0,  0.0); 

END; 

gueue_size  : 

BEGIN 

str_to_pack (' Queue  Size  vs  Time',  namel); 
str~to_pack( 'Simulation  Time  (slots) ' ,name2) 
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str_tojpack (' Average  Queue  Size' , names ) ; 
vrange ( 10 . 0 ,  0.0); 

END; 

END;  {  END  case  } 
graph_type (ORDINARY) ; 
line_connect (NO) ; 
display_onscreen(YES) ; 

symbols (DOT,  DOT,  DOT,  DOT,  DOT,  SQUARE); 
hlbl_prec(l) ; 
vlbljprec(3)  ; 
clear_display (NO,  YES) ; 

title (CENTER,  namel) ; 
haxis_lbl ( CENTER ,  name2 ) ; 
vaxis_lbl ( CENTER ,  names ) ; 

display_window(64S ,  0,  900,  0)  ; 
graph_init ; 

END; 


procedure  plot_graph(disk_file  ;  label_name) ; 

BEGIN 

str_to_pack( ' ' , namel) ; 
str_to_pack ( ' ' , name2 ) ; 
str_to_pack( ' ' , names) ; 
str~to_pack( ' ' ,name4) ; 
str_to_pack( ' ' , names ) ; 
str_to_pack(disk_file, names) ; 

plot_pairs (namel,  name2,  names,  name4,  names,  names,  1) ; 
clear_display (NO,  NO) ; 
background (NO) ; 

END; 


FUNCTION  expdev(VAR  idum:  integer) ;  double; 
BEGIN 

expdev  ;=  -In (ranS (idum) )/mean_time[ arrival] 
END; 


PROCEDURE  inter_arrival_time  (VAR  next_arrival :  double) ; 
BEGIN 

next_arrival  ;=  expdev (exp_seed) ; 

END; 


PROCEDURE  generate_event  (evkind  :  event_kind; 

current_time:  double; 
arv_time  ;  double; 

updown  :  updown_n\amber  ; 

channel  ;  channel  number; 
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station 


station_nuinber) 


VAR 

event , new_event  :  link; 
delay  :  double; 

BEGIN 

new(new_event) ; 

CASE  evkind  OF 

arrival:  {  next  arrival  } 

BEGIN 

inter_arrival_time (delay) ; 
arv_time  :=  current_time  +  delay; 
new_event " . t ime  : =  arv_t ime ; 

END; 

transmission:  {  time  to  next  sldt  } 

BEGIN 

new_event‘ .time  :=  trunc (current_time)  +  1.0001; 

END; 

resolution:  {  resolution  is  scheduled  at  the  middle  of  the  slot  } 
BEGIN 

new_event* . time  :=  current_time  +  0.5; 

END; 

wait_for_clear:  (  transmissions  that  flip  tails  } 

BEGIN 

new_event* . time  :=  trunc (current_t ime  +  1.5)  -  0.0001; 

END; 

departure:  {  total  packet  transmission  time  is  one  slot  } 

BEGIN 

new_event* , time  :=  current_time  +  0.4999; 

END; 

END_of_slot; 

BEGIN 

new_event* . time  :=  current_time  +  1.0; 

END; 

ck_glb_count : 

BEGIN 

new_event' . time  :=  trunc (current_t ime)  +  1.0001; 

END; 

tx_after_blk; 

BEGIN 

new_event “ . time  : =  current_t ime ; 

END; 

END;  {  END  CASE  ) 

WITH  new_event*  DO 
BEGIN 

kind  :*  evkind; 
arrival_time  :=  arv_time; 
updown_no  : =  updown ; 
channel_no  :=  channel; 
station_no  : =  station ; 

END;  {  with  } 
event  : =  base ; 

REPEAT 

event  :=  event *.bptr 
UNTIL  new_event* . time  >=  event'. time; 
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new_event “ . f ptr  : =  event “ . f ptr ; 
new_event " . opt r  : =  event ; 
event " . f ptr  * . bptr  : =  new_event ; 
event '.f ptr  :=  new_event; 

END ;  {  generate_event  ) 


BEGIN 

{  initialize  variables  } 
exp_seed  :=  -1; 
coin_seed  :=  -1; 
plot  :=  delay_curve; 
plot_switch  :=  TRUE; 

reset (configuration_file,  input_file) ; 
readln(configuration_file,  population) ; 
reading configuration_file,  channel_total ) ; 

station_total  :=  1; 
channel_total  :=  1; 

FOR  user  :=  1  TO  station_max  DO 
BEGIN 

readln(configuration_file,  input_rate) ; 

mean_tiine[ arrival]  ;=  mean__time[ arrival]  +  input_rate; 

END; 

readln(configuration_file,  inax_tiine)  ; 
readln(configuration_file,  plot_int) ; 
readln(conf iguration_file,  plot_yesno) ; 
close (configuration_file) ; 

max_traffic  :=  mean_tiiae[arrival] ; 
plot_f actor  ;=  (inax_traf f ic  *  inax_time) 

/  (file_size_inax  *  default_plot_interval)  ; 
plot_interval  ;=  default_plot_interval; 
if  plot_f actor  >  1.0  then 

plot_interval  ;=  default_plot_interval  *  trunc(plot_f actor  +  1.0); 

rewrite (text_file,  post_text_file) ; 
rewrite (delay_file,  post_delay_file) ; 
rewrite (throughput_file,  post_throughput_f ile) ; 
rewrite (queue_file,  post_queue_file) ; 
rewrite (plot_f ile,  plot_disk_f ile) ; 

writeln(text_file,  'Multiple  Access  Protocol  -  Tree  (single  channel)') 
writeln(text_file) ; 

writeln(text_file,  'Simulation  Results:'); 

writeln(text_file,  'Simulated  Time  Average  Delay  Throughput') 

case  plot_yesno  of 

1  :  plot_switch  :=  TRUE; 

0  ;  plot_switch  :=  FALSE; 

END;  {  END  case  } 

IF  plot_int  =  0  THEN  plot_switch  :=  FALSE; 
if  (not  plot_switch)  then  writeln( 'Running. ..') ; 
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{  create  an  empty  event  ring  } 
new (base) ; 

WITH  base"  DO 
BEGIN 

fptr  :=  base; 
bptr  ;=  base; 
time  ;=  0.0 
END; 

{  generate  arrival  at  each  station  } 

FOR  station  :=  1  TO  station_total  DO 
BEGIN 

last_departure_t ime [ station ]  : =  0 . 0 ; 
average_delay [station]  :=  0.0; 
variance_delay [station]  ;=  0.0; 
niim_of_arv[ station]  ;=  0; 
num_of_depart [station]  ;=  0; 

FOR  channel  :=  1  TO  channel_total  DO 

generate_event (arrival,  0.0,  0.0,  0,  channel,  station) ; 

END; 

{  generate  initial  conditions  for  each  channel  } 

FOR  channel  :=  1  TO  channel_total  DO 
BEGIN 

generate__event (END_of_slot,  0.0,  0.0,  0,  channel,  0); 
state [channel]  :=  idle; 
global_count[ channel]  ;=  0; 

END; 

if  plot_switch  then  plot_initiali2e; 

REPEAT 

current_event  ; =  base " . fptr ; 

WITH  current_event*  DO 
CASE  kind  OF 
arrival ; 

BEGIN 

num_of_arv[station_no]  ;=  num_of_arv[station_no]  +  1; 
generate_event (arrival,  time,  arrival_time,  updown_no,  channel_no 

station_no) ; 

generate_event (ck_glb_count,  time,  arrival_time,  updown_no, 
channel_no,  station_no) ; 

END; 

ck_glb_count : 

BEGIN 

IF  global_count[channel_no]  =  0 

THEN  generate_event (tx_after_blk,  time,  arrival_time,  updown_no 
channel_no,  station_no) 

ELSE  generate_event ( ck_glb_count ,  time,  arrival_time,  updown_no 
channel_no,  station_no) ; 

END; 

tx_after_blk,  transmission; 

BEGIN 

CASE  state [channel_no]  OF 
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idle:  state [channel_no]  :=  busy; 
busy:  state [channel_no]  :=  collision; 
collision:  state [channel_no]  :=  collision; 

END;  {  case  } 

generate_event (resolution,  time,  arrival_time,  updown_no, 
channel_no,  station_no) ; 

END; 

wait_f or_clear : 

BEGIN 

IF  state [channel_no]  =  collision 
THEN  updown_no  :=  updown_no  +  1 
ELSE  updown_no  :=  updown_no  -  1; 

IF  updown_no  =  0 

THEN  generate_event (transmission,  time,  arrival_time,  updown_no 
channe l_no ,  s t a t i on_no ) 

ELSE  generate_event (wait_for_clear,  time,  arrival_time,  up- 
down_no,  channel_no,  station_no) ; 

END; 

resolution: 

BEGIN 

IF  state [channel_no]  =  collision 
THEN 
BEGIN 


IF  global_count[channel_no]  =  0 

THEN  global_count[ channel  no]  :=  global  count [channel  no] 

+  1; 

IF  updown^no  =  0  THEN  updown_no  :=  updown_no  +  1; 

IF  ran3 (coin_seed)  >=  0.5  THEN  coin_face  :=  tail 

ELSE  coin__face  :=  head; 

IF  coin_face  =  tail 
THEN 

BEGIN  {  transmissions  that  flip  tails  ) 

generate_event (wait_for_clear,  time,  arrival_time, 
updovm__no,  channel_no,  station_no) 

END 

ELSE 

BEGIN  (  transmissions  that  flip  heads  go  on  next  slot  ) 
generate_event (transmission,  time,  arrival_time, 
updown_no,  channel_no,  station_no) 

END; 

END 

ELSE 

BEGIN 


generate_event (departure,  time,  arrival_time,  updown_no, 
channel_no,  station_no) ; 

END; 

END; 

departure : 

BEGIN 

num_of_depart [station_no]  :=  num_of_depart [station_no]  +  1; 
service_time  :=  current_event* .time  -  current_event* .arrival_time 
average_delay [station_no]  :=  average_delay [station_no]  +  service_ 

time; 

variance_delay [station_no]  :=  variance_delay [station_no] 

+  service_time  *  service  time; 


174 


0  then 


if  (num_of_depart[station_no]  mod  plot_interval)  = 

BEGIN 

writeln (delay_f ile,  current_event * .time:10:3, 

average_delay [ station_no ] /num_of_depart [ station_no ] : 10 : 5 ) 
writeln (throughput_f ile,  current_event * . time: 10 : 3 , 

niam_of_depart [station_no]/current_event*  .time:  10:5)  ; 
writeln(text_f ile,  current_event " . time: 10 : 3 , 

average_delay [ station_no ] /num_of_depart [ stat ion_no ] : 2  0 : 5 , 
num_of_depart [station_no]/current_event* . time: 18:5) ; 
if  plot_switch  then 
BEGIN 

reset (plot_f ile,  plot_disk_f ile) ; 
case  plot  of 
delay_curve: 

writeln (plot_f ile,  current_event " .time: 10:3, 
average_delay [ station_no ] /num- 
pf_depart [station_no] :10:5) ; 

throughput : 

writeln (plot_f ile,  current_event" .time: 10:3, 

num_of_depart [station_no]/current_event“ .time: 10:5) ; 
END;  {  END  case  } 
close(plot_f ile) ; 
plot_graph(plot_disk_f ile) ; 

END; 

END; 

inter_departure_time[station_no]  :=  current_event * . time 

-  last_departure_t ime [ stat ion_no ] 
last_departure_time[station_no3  :=  current_event * . time ; 

END; 

END_of_slot : 

BEGIN 


IF  State [channel_no]  =  collision 

THEN  global_count [channel_no]  :=  global_count [channel_no]  +  1 
ELSE  IF  global_count [channel_no]  >  0 

THEN  global_count[channel_no]  :=  global_count [channel_no] 


state [channel_no]  :=  idle; 

generate_event (END_of_slot,  time,  arrival_time,  updown_no, 
channel_no,  station_no) ; 

if  ( { (trunc(current_event* .time)  mod  dot_display_freq)  =  0) 
and  (not  plot_switch) )  then  write ( ' . ' ) ; 

END; 

END; 

base ‘ . f ptr  : =  current_event ‘ . f ptr ; 
current_event‘ . fptr“ .bptr  :=  base; 
backlog  :=  current_event “ . updown_no ; 
dispose (current_event) ; 

UNTIL  ( (base' . fptr* . time  >=  max_time)  or  (backlog  >=  updown_max) ) ; 


if  plot_switch  then  graph_close; 


close (delay_f ile) ; 
close (throughput_f ile) ; 
close (queue_f ile) ; 
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{  collect  statistics  } 
writeln(text_f ile) ; 

writeln(text_file,  'Final  Statistics:’); 
wr iteln ( text_f ile ,  ' ================= • ) • 

writeln(text_file, '  Maximum  simulation  slots  :  max_time: 10: 2) ; 

writeln(text_file, '  Number  of  Channels  channel_total:5) ; 
writeln{text_file, '  Average  arrival  rate 

mean_time[arrival] ; 10:5,  '  packets  per  slot'); 
wr iteln (text_f ile, '  Number  of  Delay 

(slots) ' )  ; 

writeln(text_f ile, '  Station  arrival  departure  average 

variance ' ) ; 

FOR  station  :=  1  TO  station_total  DO 
BEGIN 

IF  num_of_depart[ station]  =  0 

THEN  average_delay [station]  :=  0.0 

ELSE  average_delay [station]  :*  average_delay [station] 

/  num_of_depart[ station] ; 

IF  num_of_depart [station]  <=  1 

THEN  variance_delay [station]  :=  0.0 

ELSE  variance_delay [station]  :=  (variance_delay [station] 

-  num_of_depart [station]  *  aver age_del ay [station]  *  average_delay [sta¬ 
tion]  ) 

/  (num_of_depart [station]  -  1) ; 

writeln(text_file,  station: 10, 

num_of_arv[ station] :10,  num_of_depart [station] :10, 
average_delay [station] : 15: 5,  variance_delay [station] : 15: 5) ; 

END; 

close (text_f ile) ; 

END. 
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[**********************  UNILOOP. PAS  ************************) 

program  uni_directional_loop_network( input,  output) ; 

{$I  sci-graf . inc} 


const 

station_max 

channel_max 

session_max 

queue_max 

f i 1 e_s i z  e_max 

default_plot_interval 

do t_d isplay_freq 

post_text_file 

plot_disk_f ile 

post_delay_file 

pos t_thr oughput_f ile 

post_queue_file 

i nput_ne two r k_f ile 


8; 

8; 

64; 

20; 

100; 

10; 

1000; 

' posttext . dat ' 
'plotfile.dat' 
'posdelay.dat' 
' posthrpt . dat ' 
• posgueue . dat ' 
' uniloop. tdt' ; 


type 

str80 

label_name 

plot_type 

node_numt)er 

session_number 

channel_number 

event_kind 

link 

event 


packed  array[1..80]  of  char; 
string [80] ; 

(delay_curve,  throughput,  queue_size) ; 
0 . . station_max ; 

0 . . session_max ; 

0 . . channel_max ; 

(arrival,  rcv_pkt,  departure) ; 

‘event; 

record 

fptr,  bptr  ;  link; 
kind  ;  event_kind ; 
time  :  double ; 
arrival_time  ;  double; 
pkt_time  :  double; 
node_no  :  node_number; 
session_no  ;  session_number 
end; 


var 

origin,  session,  channel,  node,  exp_seed 

pkt_length,  pkt_time,  max_pkt_time,  max_time,  service_time 
dummy,  f ixed_pkt_length 
current_event ,  base 


integer; 

double; 

double; 

link; 


{  graphics  oriented  variables  ) 
network_file,  text_file 

plot_file,  delay_file,  throughput_f ile,  queue_file 
plot_yesno,  plot_int,  plot_session 
plot_channel,  plot_interval 

plot_session_in,  plot_session_out ,  plot_channel_in 

plot_channel_out 

plot_factor 

plot_switch 


text ; 
text ; 
integer; 
integer ; 
integer; 
integer; 
double; 
boolean; 
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plot 

namel,  naine2,  naine3,  naine4,  names,  name6 


:  plot_type; 
:  strSO; 


{  session  oriented  variables  ) 
session_total 
max_traf fic 

num_o f  arv .  num_o f __depart 
mean^kt_length,  traffic_rqmt 
session_rqmt 

average_delay,  variance_delay 

last_departure_time 

inter_departure_time 


session_nuinber ; 
double; 

array  [session_number]  of  longint; 
array [session_number]  of  double; 
array[session_number,l. .2]  of  node_number 
array  [session_number]  of  double; 
array  [session_number]  of  double; 
array  [session_number]  of  double; 


{  channel  oriented  variables  } 

channel_total  :  channel_number ; 

back_log  :  array [channel_number]  of  integer; 

last_arrival_time,  wait_time,  capacity  :  array [channel_number]  of  double; 

route  :  array [node_number, session_number]  of  channel_number 


{  node  oriented  variables  } 

origin_no,  destination_no,  node_total  :  node_number; 

node _process_time  :  array [node_number]  of  double; 

link_matrix  ;  array[channel_number,l. .2]  of  node_number; 

row,  column  :  node  number; 


{  variables  for  random  number  generation  } 

glinext,  glinextp  :  integer; 

glma  ;  array  [1..55]  of  double; 


{ 


the  network  is  characterized  by  three  matrices: 
1.  link  matrix 


channel  number 


from  to 


node  no  node  no 


capacity 


bits/sec 


2.  session  matrix 


session  number 


origin 


node  no 


destination 


node  no 


traffic_rqmt 


packets/sec 


mean_pkt_length 


bits/packet 


3.  rotuing_matrix 


session  number 


node_process_time 
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node_number  out_bound_queue  channel_nuinber  seconds 


{$I  header. inc} 

function  ran3  (var  idvim;  integer):  double; 
const 

mbig  =  4.0e6; 

mseed  =  1618033.0; 

mz  =0.0; 

fac  =  2.5e-7;  (*  1/mbig  *) 

var 

i,ii,k  ;  integer; 

inj,ink  :  double; 

begin 

if  (idum  <  0)  then 
begin 

mj  :=  mseed+idum; 

if  inj>=0.0  then  mj  :=  mj-mbig*trunc(mj/mbig) 

else  mj  ;=  mbig-abs(mj)+mbig*trunc(abs(mj)/mbig) ; 
glma[55]  :=  mj ; 
mk  :=  1; 

for  i  :=  1  to  54  do 
begin 

ii  ;=  21*i  mod  55; 
glma[ii]  :=  mk; 
mk  ;=  mj-mk; 

if  (mk  <  mz)  then  mk  :=  mk+mbig; 
mj  ;=  glma[ii] 
end; 

for  k  :=  1  to  4  do 
begin 

for  i  ;=  1  to  55  do 
begin 

glma[i]  ;=  glmaCi]-glma[l+( (i+30)  mod  55)]; 
if  (glma[i]  <  mz)  then  glma[i]  :=  glma[i]+mbig 
end 

end; 

glinext  ;=  0; 
glinextp  :=  31; 
idum  : =  1 
end; 

glinext  ;*  glinext+1; 

if  (glinext  =  56)  then  glinext  :=  1; 

glinextp  ;=  glinextp+1; 
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if  (gllnextp  =  56)  then  glinextp  ;=  1; 
mj  :=  glma [glinext]-glina [glinextp] ; 
if  (mj  <  mz)  then  mj  :=  mj+mbig; 
glma[glinext]  :=  m j ; 
ran3  :=  mj*fac 
end; 


procedure  str_to_pack(  in_str  :  label_name; 

var  pack_str  ;  strSO  ) ; 

var 

max_length,  element  :  integer; 
begin 

max_length  :=  length ( in_str) ; 
for  element  ;=  1  to  max_length  do 

pack_str [element]  :=  in_str [ element] ; 
pack_str [max_length+l]  :=  chr(O) ; 
end; 


procedure  plot_initialize; 
begin 

case  plot_int  of 

1  ;  plot  ;=  delay_curve; 

2  :  plot  ;=  throughput; 

3  ;  plot  :=  queue  size; 

end; 

auto_select_display ; 
virtual_display (YES) ; 
hrange (max_time ,  0.0); 
case  plot  of 
delay_curve  : 
begin 

str_to_pack( ' Delay  vs  Time',  namel) ; 
str_to_pack( 'Simulation  Time  (seconds) name 2) 
str_to_pack( 'Average  Delay  (seconds) ' ,name3) ; 
vrange ( queue_max  *  max_pkt_time,  0.0) ; 
end; 

throughput  ; 
begin 

str_to_pack (' Throughput  vs  Time',  namel); 
str_tojpack( 'Simulation  Time  (seconds) ' ,name2) 
str_to_pack( 'Average  Throughput' ,name3) ; 
vrange (1.0,  0.0); 
end; 

queue_size  : 
begin 

str_to_pack (' Queue  Size  vs  Time',  namel); 
str_to_pack( 'Simulation  Time  (seconds) ', name2) 
str_tojpack( 'Average  Queue  Size' ,name3) ; 
vrange ( queue_max* 1 . 0 ,  0.0); 
end; 

end;  {  end  case  } 
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graph_type (ORDINARY) ; 
line_connect (NO) ; 
display_onscreen(YES) ; 

symbols(DOT,  DOT,  DOT,  DOT,  DOT,  SQUARE); 
hlbl_prec(l) ; 
vlbl_prec ( 3 ) ; 
clear_display (NO,  YES) ; 

title (CENTER,  namel) ; 
haxis_lbl  (CENTER,  naine2)  ; 
vaxis_lbl (CENTER,  names); 

display_window(643 ,  0,  900,  0); 
graph_init ; 
end; 


procedure  plot_graph(disk_f ile  :  label_name) ; 
begin 

str_to_pack( ' ' , namel) ; 
str_to_pack ( ' ' , name2 ) ; 
str_to_pack ( ' ' , names ) ; 
str_to_pack ( ' ' , name4 ) ; 
str_to_pack ( ' ' , names ) ; 
str_tojpack(disk_f ile, names) ; 

plot _pairs (namel,  name2,  names,  name4,  names,  names,  1) ; 
clear_display (NO,  NO) ; 
background (NO) ; 
end; 


function  expdev(var  idum:  integer;  session:  integer) ;  double; 
begin 

expdev  :=  -ln(  ran3(idum)  )/traffic_rqmt[session] ; 
end; 


procedure  inter_arrival_time  (var  next_arrival  :  double; 

session  :  integer) ; 

begin 

next_arrival  ;=  expdev (exp_seed,  session) ; 
end; 


procedure  pkt_distribution(var  pkt_size:  double;  session:  integer) ; 
begin 

pkt_size  :=  mean_pkt_length[session) ; 
end;  ~ 


procedure  generate_event  (evkind  :  event_kind; 

current_t ime :  double ; 
arv  time  :  double; 
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pkt_len 
node 
session 

var 

event , new_event  :  link; 
out_bound_queue  :  channel_nuinber ; 
delay  :  double ; 

begin 

new(new_event) ; 
case  evkind  of 

arrival:  {  next  arrival  } 
begin 

inter_arrival_tiine (delay,  session)  ; 
arv_tinie  :=  current_time  +  delay; 
new_event " . time  : =  arv_t ime ; 
end; 

departure : 
begin 

new_event* . time  ;=  current_time  +  node_process_t ime [ node ] ; 
end; 

rcv_pkt : 
begin 

out_bound_queue  :=  route [node, session] ; 

new_event* . time  :=  current_time  +  nodejprocess_t ime [node] 

+  pkt_len  +  wait_time[out_bound_queue] ; 

end; 

end;  {  end  case  } 

with  new_event“  do 
begin 

kind  :=  evkind; 
arrival_time  :=  arv_time; 
pkt_time  :=  pkt_len; 
node_no  ; =  node ; 
session_no  :=  session; 
end;  {  with  ) 
event  : =  base ; 
repeat 

event  : =  event “ . bptr 

until  new_event“ . time  >=  event “.time; 
new_event “ . f ptr  ; =  event “ . f ptr ; 
new_event “ . bptr  : =  event ; 
event “ . f ptr “ . bptr  ; =  new_event ; 
event “ . f ptr  : =  new_event ; 
end;  (  generate^event  ) 

begin 

{  read  in  network  size  } 

reset (network_file,  input_network_file) ; 
readln(network_file,  node_total) ; 

{  read  in  ploting  switch  } 

readln(network_f ile,  plot_session_in) ; 


:  double; 

:  node_number ; 

:  session_number) ; 
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readln(network_file,  plot_session_out) ; 

readln ( network_f ile ,  plot_channel_in) ; 

readln(network_file,  plot_channel_out) ; 

plot_session  ;=  1; 

plot_channel  :=  1; 

plot  ;=  delay_curve; 

plot_switch  ;=  TRUE; 

{  read  in  network  matrices  } 
session  :=  1; 

for  row  :=  1  to  station_max  do  {  build  session  matrix  from  traffic  matrix 
for  column  ;=  1  to  station_max  do  begin 

readln (network_f ile,  traffic_rqmt [ session ] ) ; 
if  (abs (traffic_rqmt [session] )  >  l.Oe-6  )  then  begin 
session_rqmt[session, 1]  :=  row; 
session_rqmt[ session, 2]  :=  column; 

if  ( (plot_session_in  =  row)  and  (plot_session_out  =  column) ) 
then  plot_session  :=  session; 
mean_pkt_length[ session]  :=  1.0; 
session  :=  session  +1; 
end; 
end; 

session_total  :=  session  -  1; 
channel_total  :=  node_total; 

for  channel  :=  1  to  channel_total  do  begin  {  build  link  matrix  ) 
readln (network_f ile,  capacity [channel] ) ; 

1  ink_mat r ix  [  channel ,  1  ]  ;  ==  channel ; 

link_matrix[ channel, 2]  ;=  (channel  mod  node_total)  +  i; 
if  ( (plot_channel_in  =  1 ink_matrix[ channel, T] )  and 
(plot_channel_out  =  link_matrix[channel,2] ) ) 
then  plot_channel  ;=  channel; 

end; 

{  read  in  dummy  entries  } 

if  (channel_total  <  channel_max)  then 

for  channel  :=  (channel_total  +  1)  to  channel_max  do 
readln (network_f ile,  dummy) ; 

for  node  ;=  1  to  node_total  do  {  build  routing  matrix  for  uniloop  only  } 
begin 

node_process_t ime [ node ]  : =  0 . 0 ; 
for  session  :=  1  to  session_total  do 

route [node, session]  ;=  link_matrix[node, 1] ; 

end; 

readln (network_f ile,  max_time) ; 
readln (network_f ile,  plot_int) ; 
readln (network_f ile,  plot_yesno) ; 

close (network_f ile) ; 

{  echo  the  three  matrices  } 

rewrite (text_f ile,  post_text_file) ; 

writeln(text_file,  ' Store-and-Forward  Network  -  Uni-Directional  Loop'); 
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writeln(text_file) ; 
writeln(text_file,  'Input'); 
writeln(text_file,  '===='); 
writeln(text_file,  '  Routing  Matrix  :'); 
for  node  :=  1  to  node_total  do  {  routing  matrix  } 
begin 

for  session  :=  1  to  session_total  do 

write (text_file,  route[ node, session] : 3) ; 
writeln(text_file,  node_process_time[node] : 10: 5) ; 
end; 

writeln(text_file) ; 

writeln(text_file,  '  Session  Matrix  :'); 

for  session  :=  1  to  session_total  do  {  session  matrix  } 

writeln(text_f ile,  sess ion_rqmt[ session, 1] ;3,  session_rqmt[ session, 2] ;3, 
traffic_rqmt[ session] :10:5,  mean_pkt_length[ session] :10:5) ; 
writeln(text_file) ; 

writeln(text_file,  '  Link  Matrix  :'); 

for  channel  ;=  1  to  channel_total  do  {  link  matrix  } 

writeln(text_file,  1 ink_matrix[ channel, 1] :3,  link_matrix[ channel, 2] ;3, 
capacity [channel] :10:5) ; 
writeln(text_file) ; 

writeln(text_file,  'Simulation  Results  of  Session' ,plot_session: 4) ; 
writeln(text_f ile,  'Simulated  Time  Average  Delay  Throughput'); 

{  initialize  variables  } 
exp_seed  -1; 

for  channel  ;==  1  to  channel_total  do 
begin 

wait_time[ channel]  ;=  0.0; 
last_arrival_time[ channel]  ;=  0.0; 
back_log[ channel]  :=  0; 
end; 

max_traffic  :=  0.0; 
for  session  :=  1  to  session_total  do 
begin 

last_departure_time[ session]  ;=  0.0; 
average_delay[ session]  ;=  0.0; 
variance_delay [session]  ;=  0.0; 
num_of_arv[ sess ion]  :=  0; 
num_of _depart [ sess ion ]  : =  0 ; 
if  max_traffic  <=  traffic_rqmt[ session]  then 
max_traffic  :=  traffic_rqmt [ session ] ; 

end; 

plot_factor  (max_traffic  *  max_time) 

/  (file_size_max  *  default_plot_interval) ; 
plot_interval  ;=  default_plot_interval; 
if  plot_factor  >  1.0  then 

plot_interval  :=  default_plot_interval  *  trunc (plot_f actor  +  1.0); 

rewrite (delay_f ile,  post_delay_f ile) ; 
rewrite (throughput_f ile,  post_throughput_file) ; 
rewrite (queue_f ile,  post_queue_f ile) ; 
rewrite (plot_f ile,  plot_disk_file) ; 
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case  plot_yesno  of 

1  :  plot_switch  ;=  TRUE; 

0  :  plot_switch  :=  FALSE; 
end;  {  end  case  } 

if  plot_int  =  0  THEN  plot_switch  ;=  FALSE; 
if  (not  plot_switch)  then  writeln( 'Running. ; 

{  create  an  empty  event  ring  } 
new (base) ; 
with  base"  do 
begin 

fptr  ;=  base; 
bptr  base; 
time  :=  0.0 
end; 

{  generate  arrival  for  each  session  ) 
max_pkt_t ime  : =  0.0; 
for  session  :=  1  to  session_total  do 
begin 

origin  :=  session_rgmt [session,  1] ; 
channel  :=  route[origin, session] ; 
pkt_distribution(pkt_length,  session) ; 
pkt_time  ;=  pkt_length  /  capacity [ channel ] ; 
if  max_pkt_time  <=  pkt_time  then  max_pkt_time  ;=  pkt_time; 
generate_event (arrival,  0.0,  0.0,  pkt_time,  origin,  session); 
end; 

if  plot__switch  then  plot_initialize; 
repeat 

current_event  :=  base ".fptr; 
with  current_event "  do 
case  kind  of 
arrival : 
begin 

num_of_arv[session_no]  ;=  num_of_arv[session_no]  +  l; 
generate_event( arrival,  time,  arrival_time,  pkt_time,  node_no, 

session_no) ; 

channel  ;=  route [ node_no, session_no] ; 
if  back_log[ channel]  =  0  then 
begin 

wait_time[ channel]  ;*  0.0; 

last_arrival_time[ channel]  ;=  arrival_time ; 
back_log[ channel]  ;=  back_log[ channel]  +  1; 
end 
else 
begin 

wait_time[ channel]  :=  wait_time[ channel]  +  pkt_time 

-  (  arrival_time  -  last_arrival_time[ channel]  ) ; 
last_arrival_time[ channel]  ;=  arrival_time; 
if  wait_time[ channel]  <=  0.0  then 
wait_time[ channel]  ;=  0.0; 
back_log[ channel]  ;=back_log[ channel]  +  1; 
end; 
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generate_event (rcv_pkt,  time,  arrival_time,  pkt_time,  node_no, 

session_no) ; 

if  ( (num_of_arv[plot_session]  mod  dot_display_freq  =  0) 
and  (not  plot_switch) )  then  write ( ' . ' ) ; 

end; 

departure : 
begin 

num_ot_depart [session_no]  :=  num_of_depart [session_no]  +  1; 
service_time  :=  current_event'‘ .  time  -  current_event" .  arrival_time 
average_delay [session_no]  :=  average_delay [session_no]+service_- 

time; 


sion_no] ; 


variance_delay [session_no]  :=  variance_delay [session_no] 

+  service_time  *  service_time; 
inter_departure_time[session_no]  ;=  current_event" . time 

-  last_departure_time[ses- 

last_departure_time[session_no]  :=  current  event* .time; 


if  (num_of_depart [session_no]  mod  plot_interval)  =  0  then 
begin 

if  plot_session  =  session_no  then 
begin 

writeln(delay_file,  current_event * .time: 10:3, 
average_delay (session_no]/num_of_depart [session_no] : 10: 5) 
writeln(throughput_file,  current_event * .time: 10:3, 
num_of_depart [session_no]/num_of_arv[session_no] :10:5) ; 
writeln(text_file,  current_event* .time: 10:3, 
average_delay [ session_no ] /num_of_depart [ session_no ] : 2  0 : 5 , 
num_of_depart [session_no]/num_of_arv[session_no] :18:5) ; 

end; 

if  plot_switch  then 
begin 

reset (plot_file,  plot_disk_file) ; 
case  plot  of 

delay_curve;  if  plot_session  =  session_no  then 
writeln(plot_file,  current_event* .time: 10:3, 
average_delay [ session_no ] /num_of_depart [ ses- 

sion_no] : 10: 5) ; 

throughput:  if  plot_session  =  session_no  then 
writeln(plot_file,  current_event* .time: 10:3, 
num_of_depart [ session_no ] /num_of_arv [ ses- 

sion_no] : 10: 5) ; 

end;  {  end  case  ) 
close (plot_file) ; 
plot_graph(plot_disk_file) ; 
end; 

end; 

end; 


rcv_pkt : 
begin 

channel  :=  route[node_no, session_no] ; 
back_log[ channel]  :=  back_log [ channel ]  -  1; 

if (num_of_depart [session_no]  mod  plot_interval)  =  0  then 
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begin 

if  plot_channel  =  channel  then 
writeln(queue_file,  current_event " .time: 10:5, 
back_log[ channel] :5) ; 

if  plot_switch  then 
begin 

reset (plot_file,  plot_disk_f ile) ; 
if  plot  =  gueue_size  then 

if  plot_channel  =  channel  then 

writeln(plot_file,  current_event " .time: 10:5, 
back_log[ channel] :5) ; 
close (plot_f ile) ; 
plot_graph(plot_disk_file) ; 
end; 
end; 

node  :=  link_matrix[channel,23 ; 
if  node  =  session_rqmt[session_no, 2] 
then 

{  final  destination  } 
begin 

generate_event (departure,  time,  arrival_time,  pkt_time,  node, 

session_no) 

end 

else 

{  route  to  next  node  ) 
begin 

channel  :=  route[node,session_no] ; 
if  back_log[ channel]  =  0  then 
begin 

wait_time [channel]  :=  0.0; 

back_log[ channel]  :=*  back_log[ channel]  +  1; 
last_arrival_time[ channel]  :=  time; 
end 
else 
begin 

wait_time[ channel]  :=  wait_time[ channel]  +  pkt_time 

-  (  time  -  last_arrival_time[ channel]  ) ; 
last_arrival_time[ channel]  :=  time; 
if  wait_time[ channel]  <=  0.0  then 
wait_time[ channel]  :=  0.0; 
back_log[ channel]  :=  back_log[ channel]  +1; 
end; 

generate_event (rcv_pkt,  time,  arrival_time,  pkt_time,  node, 

session_no) ; 

end; 

end; 

end; 

base'.fptr  :=  current_event* . fptr; 
current_event  * . f ptr  * . bptr  : *  base ; 
dispose (current_event) ; 
until  ( (base" . fptr" .time  >=  max_time) 

or  (back_log[plot_channel]  >=  queue_max) ) ; 
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if  plot_switch  then  graph_close; 

close (delay_file) ; 
close {throughput_file) ; 
close (gueue_file) ; 

{  collect  statistics  } 
writeln(text_file) ; 

writeln(text_f ile,  'Final  Statistics:'); 
writeln(text_file,  '================•)  ; 

writeln(text_file, '  maximum  simulation  time:  ',  max_time: 10: 2 ,  '  seconds') 
for  session  :=  1  to  session_total  do 

writeln(text_file, '  average  arrival  rate  of  session',  session:5,  '  is', 
traffic_rqmt [session] : 10:5,  '  packets  per  second'); 
writeln(text_file, '  number  of  delay 

(seconds) ' )  ; 

writeln(text_file, '  session  arrival  departure  average 

variance ' ) ; 

for  session  :=  1  to  session_total  do 
begin 

if  num_of_depart [session]  =  0 

then  average_delay[ session]  :=  0.0 

else  average_delay[ session]  :=  average_delay [session] 

/  num_of_depart [ session ] ; 

if  num_of_depart [session]  <=  1 

then  variance_delay[ session]  ;=  0.0 

else  variance_delay [session]  :«  (variance_delay [session] 

-  num_of_depart [session]  *  average_^delay [session]  *  average_delay [ses¬ 
sion]) 

/  (num_of_depart [session]  -  1)  ; 

writeln(text_file,  session: 10, 

num_of_arv[ session] :10,  num_of_depart [session] :10, 
average_delay[session] : 15: 5,  variance_delay [session] : 15 : 5) ; 

end; 

close (text_f ile) ; 
end. 
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